Código:
Sub CambiarTipoFuente()
Dim r As Range, x As Range, c As Range, p As Range, b() As String, f As String
On Error Resume Next
Set r = Application.InputBox("Selecciona el rango donde se aplicará el cambio de tipo 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 tipo de fuente:", "Aprendiendo ẽXcel365", , Type:=8)
On Error GoTo 0
f = InputBox("Ingresa el tipo de fuente deseado:", "Aprendiendo ẽXcel365")
If f <> "" Then
If Not r Is Nothing And Not x Is Nothing 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.Name = f
End If
Next i
Next c
Else
MsgBox "No se han seleccionado rangos válidos."
End If
End If
End Sub
⭐ Si te gustó, por favor regístrate en nuestra Lista de correo y Suscríbete a mi canal de YouTube para que estés siempre enterado de lo nuevo que publicamos
