Excel: Macro: Cambiar color de texto entre paréntesis

Introducción

Este es un pequeño macro que es de gran utilidad para resaltar texto entre paréntesis, por ejemplo, en cualquier lugar del documento en el que se esté trabajando.

Desarollo

Este macro cambia de color el texto dinámicamente según la configuración que puede realizar el usuario en una de sus hojas.


En la imagen anterior podemos ver que se han configurado cuatro tipos de caractéres para que al escribir un texto entre paréstesis este cambia al color seleccionado en las celdas de color.

Esto resulta muy útil cuando es importante estar resaltando diferentes tipos de texto o para hacer correcciones y que estas llamen la atención rápidamente.

Los cambios Row Begin y Row End sirven para indicar las filas de inicio y fin respectivamente, es decir, el macro tomará el rango A2:B5 como el conjunto evaluador y cambiará los colores según corresponda.

La imagen anterior sería el resultado final según la configuración de la imagen uno, si se desean añadir más tipos de evaluaciones por ejemplo en A6:B6, se deben modificar el valor de RowEnd para que considere esta nueva evaluación.

El macro responble de está gran herramienta para resaltar texto entre paréstesis en Excel o en cualquier otro caractér es el siguiente, y está ubicando en ThisWorkbook en el visor de Visual Basic de Excel.

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
   On Error GoTo Oops
   
   ' Declare Dim
   Dim y As Integer
   Dim esY As Integer
   
   ' Dim for chars
   Dim lBegin As String
   Dim lEnd As String
      
   ' Application config
   Application.ScreenUpdating = False
   Application.DisplayAlerts = False

   'Dinamyc adding chars
   For q = CInt(ActiveWorkbook.Sheets("Config").Range("G2").Text) To CInt(ActiveWorkbook.Sheets("Config").Range("H2").Text)
     
    'Get chars
    lBegin = ActiveWorkbook.Sheets("Config").Range("A" & q).Text
    lEnd = ActiveWorkbook.Sheets("Config").Range("B" & q).Text
    
    'Reset Dim
    y = 0
    esY = 0
    
    'Target is the current selection
    For x = 1 To Len(Target)
                 
        'Remove Text Bold
        With Target.Characters(k, 1).Font
             .Bold = False
        End With
               
        ' Search the first symbol
        If (Mid(Target.Text, x, 1) = lBegin And esY = 0) Then
            y = x
            esY = 1
        ' Search end symbol
        MsgBox lBegin & x
        Else
         If (Mid(Target.Text, x, 1) = lEnd And esY = 1) Then
          MsgBox y & lEnd & x
           For k = y To x
               ' Paint text with cell color
               With Target.Characters(k, 1).Font
                   .Color = ActiveWorkbook.Sheets("Config").Range("C" & q).Characters.Font.Color
                   .Bold = True
               End With
           Next
         esY = 0
         End If
        End If
     Next
   Next
' Do not show error messages
Oops:
 Resume Next
End Sub

Conslusión

Espero que este macro sea de gran ayuda para ustedes y que puedan sacarle provecho. En el siguiente enlace puede descargar el archivo completo.