Codigo:
Sub CambiarColorFuente()
Dim r As Range, x As Range, c As Range, p As Range, b() As String, h As Long
On Error Resume Next
Set r = Application.InputBox("Selecciona el rango donde se aplicará el cambio de color de fuente:", "Aprendiendo eXcel", , Type:=8)
On Error GoTo 0
On Error Resume Next
Set x = Application.InputBox("Selecciona el rango con las palabras a cambiar el color de fuente:", "Aprendiendo eXcel", , Type:=8)
On Error GoTo 0
h = RGB(255, 0, 0)
Dim colorHex As String
colorHex = InputBox("Ingresa el color de fuente deseado en formato hexadecimal (ejem #FFFFFF):", "Aprendiendo eXcel")
If colorHex <> "" Then
On Error Resume Next
h = RGB( _
CLng("&H" & Mid(colorHex, 1, 2)), _
CLng("&H" & Mid(colorHex, 3, 2)), _
CLng("&H" & Mid(colorHex, 5, 2)) _
)
On Error GoTo 0
If h = 0 Then
MsgBox "Formato de color no válido. " & Chr(13) & "Asegúrate de ingresar seis caracteres hexadecimales (ejem #FFFFFF).", "Aprendiendo eXcel"
Exit Sub
End If
Else
Exit Sub
End If
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.Color = h
End If
Next i
Next c
Else
MsgBox "No se han seleccionado rangos válidos.", "Aprendiendo eXcel"
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.
