Format TextBox Text Between and Including Apostrophes

[jstevens]

Is it possible to format a Textbox's text where the text is between the apostrophes and including the apostrophes?

Code: Select all

These words are formattedRed; 'Red01', 'Red02' and 'Red03'

Note! The red words have a leading and ending apostrophe.  The apostrophe should also be formatted red.

Red words will always have a leading and ending apostrophe.  Is it possible to have the array format all text between and including the apostrophes red?

Something like myRedArray = Array("''")?

I have attached a sample workbook.

Your thoughts are appreciated.

Format_Textbox_Text.xlsm

[HansV]

I think it's better to handle text between single quotes separately.

Code: Select all

Sub Format_Textbox_Lines()
    Dim tfrTextFrame As TextFrame
    Dim strText As String
    Dim rgbPink As Long
    Dim rgbBlue As Long
    Dim rgbRed As Long

    rgbBlue = RGB(0, 0, 255)   ' blue
    rgbPink = RGB(255, 0, 255) ' pink
    rgbRed = RGB(255, 0, 0)    ' red

    Dim myBlueArray As Variant
    myBlueArray = Array("Blue", "Blue01", "Blue02", "Blue03")

    Dim myPinkArray As Variant
    myPinkArray = Array("Pink", "Pink01", "Pink02", "Pink03")

    Dim myRedText As String
    myRedText = "'[^']*'"

    Set tfrTextFrame = Sheets("Sheet1").Shapes("TextBox 1").TextFrame

    ' Clear formatting
    tfrTextFrame.Characters.Font.Bold = False
    tfrTextFrame.Characters.Font.color = vbBlack

    'Format based on arrays
    FormatWords tfrTextFrame, myBlueArray, rgbBlue
    FormatWords tfrTextFrame, myPinkArray, rgbPink
    FormatQuoted tfrTextFrame, myRedText, rgbRed
End Sub

Sub FormatWords(tfrTextFrame As TextFrame, wordsArray As Variant, color As Long)
    Dim regex As Object
    Set regex = CreateObject("VBScript.RegExp")
    regex.Global = True
    regex.IgnoreCase = True

    Dim word As Variant
    Dim matches As Object
    Dim match As Object

    For Each word In wordsArray
        regex.Pattern = "\b" & word & "\b" ' Match whole word

        If regex.test(tfrTextFrame.Characters.Text) Then
            Set matches = regex.Execute(tfrTextFrame.Characters.Text)
            For Each match In matches
                tfrTextFrame.Characters(match.FirstIndex + 1, Len(match.Value)).Font.color = color
                tfrTextFrame.Characters(match.FirstIndex + 1, Len(match.Value)).Font.Bold = True
            Next match
        End If
        DoEvents
    Next word
End Sub

Sub FormatQuoted(tfrTextFrame As TextFrame, word As String, color As Long)
    Dim regex As Object
    Set regex = CreateObject("VBScript.RegExp")
    regex.Global = True
    regex.IgnoreCase = True
    regex.Pattern = word

    Dim matches As Object
    Dim match As Object

    If regex.test(tfrTextFrame.Characters.Text) Then
        Set matches = regex.Execute(tfrTextFrame.Characters.Text)
        For Each match In matches
            tfrTextFrame.Characters(match.FirstIndex + 1, Len(match.Value)).Font.color = color
            tfrTextFrame.Characters(match.FirstIndex + 1, Len(match.Value)).Font.Bold = True
        Next match
    End If
End Sub

[jstevens]

Thank you Hans!