Código:
Sub CambiarTamañoFuente()
Dim r As Range, x As Range, t As Integer, c As Range, p As Range
Dim b() As String
On Error Resume Next
Set r = Application.InputBox("Selecciona el rango donde se aplicará el cambio de tamaño de fuente:", "Aprendiendo ẽXcel365", , Type:=8)
On Error GoTo 0
On Error Resume Next
Set x = Application.InputBox("Selecciona el rango con las palabras a cambiar el tamaño de fuente:", "Aprendiendo ẽXcel365", , Type:=8)
On Error GoTo 0
t = InputBox("Ingresa el tamaño de fuente deseado:", "Aprendiendo ẽXcel365")
If Not r Is Nothing And Not x Is Nothing And t > 0 Then
ReDim b(1 To x.Cells.Count)
Dim i As Integer
i = 1
For Each p In x
b(i) = p.Value
i = i + 1
Next p
For Each c In r
For i = LBound(b) To UBound(b)
If InStr(1, " " & c.Value & " ", " " & b(i) & " ") > 0 Then
Dim posInicio As Integer
posInicio = InStr(1, " " & c.Value & " ", " " & b(i) & " ")
c.Characters(Start:=posInicio, Length:=Len(b(i))).Font.Size = t
End If
Next i
Next c
Else
MsgBox "No se han seleccionado rangos válidos o el tamaño de fuente es inválido."
End If
End Sub
