Word VBA for Highlight Strings in Text box #2

Introduction

When checking text, coloring or bolding specific characters can make them easier to see and check. To do this, you need to set a Find string for a specific strings, and color or bold the Replace string.
The Word VBA string color scheme macro introduced here allows you to set RGB color codes in an RGB color code table and list Find and Replace string, enabling you to set color or bold for specific strings in a TextBox.
You can create replacement string that can be colored or bolded to make the strings you want to emphasize stand out by making them a striking color or bold.

Sample code for Sub Table_RGBsample_english() and Sub colorTable() are available in the unpaid article. You can display an RGB code table and an example of text boxes. By running the Sub colorTable() macro, you can assign colors to the replacement strings in the RGB code table.
Sample code for Sub colorTxBox() is in the paid article. By running the Sub colorTxBox() macro, you can assign colors to the replacement strings in the text boxes.
You can request a refund for the paid portion of this article within 24 hours.

Sample Code Installation

1) Sub Table_RGBsample_english()

Create a sample RGB color code table and an example of text boxes.
In a new Word file, it recommend setting the margins narrow to make the table wider. Save the file as a Word macro-enabled document (*.docm).

Select Develop → Visual Basic to open the VB editor.

In the VB editor, select Project → Insert → Standard Module in a new document to create a standard module and Module1 under it.

Copy the code for Sub Table_RGBsample_english() below into Module1 of the standard module.

Sub Table_RGBsample_english()  'Create a sample RGB color code table and text input example
    Dim doc As Document
    Dim tbl As Table
    Dim i As Integer
    
    ' Set ActiveDocument
    Set doc = ActiveDocument
    
    ' Set the font and size of the text
    With Selection.Font
        .Name = "Arial"
        .Size = 16
    End With
    
    ' Set line spacing to a fixed value of 20 points
    With Selection.ParagraphFormat
        .LineSpacingRule = wdLineSpaceExactly
        .LineSpacing = 20
    End With
    ' Add the first line of text
    Selection.TypeText text:="#Word VBA #Color strings 　#Highlight strings　#@reskill_craft"
    Selection.TypeParagraph
    ' Add the 2nd line of text
    Selection.TypeText text:="RGB Color Code Table"
    Selection.TypeParagraph
    Selection.TypeParagraph
    ' Set the font and size of the text
    With Selection.Font
      .Name = "Arial"
      .Size = 12
    End With
    ' Add table
    Set tbl = doc.Tables.Add(Selection.Range, 10, 8)
    ' Set the font and size of the text
    With Selection.Font
        .Name = "Arial"
        .Size = 12
    End With
    
    ' Formatting a table
    With tbl
        .LeftPadding = Application.CentimetersToPoints(0.5)
        .Rows.Height = Application.CentimetersToPoints(0.8)
        
        ' Set column width
        .Columns(1).Width = Application.CentimetersToPoints(1)
        .Columns(2).Width = Application.CentimetersToPoints(2.5)
        .Columns(3).Width = Application.CentimetersToPoints(1.6)
        .Columns(4).Width = Application.CentimetersToPoints(1.6)
        .Columns(5).Width = Application.CentimetersToPoints(1.6)
        .Columns(6).Width = Application.CentimetersToPoints(4)
        .Columns(7).Width = Application.CentimetersToPoints(4)
        .Columns(8).Width = Application.CentimetersToPoints(2)
        
        ' Set grid lines
        .Borders.Enable = True
    End With
    
    ' Set grid lines Enter the header for the first row
    tbl.Cell(1, 1).Range.text = "#"
    tbl.Cell(1, 2).Range.text = "color"
    tbl.Cell(1, 3).Range.text = "R"
    tbl.Cell(1, 4).Range.text = "G"
    tbl.Cell(1, 5).Range.text = "B"
    tbl.Cell(1, 6).Range.text = "Find"
    tbl.Cell(1, 7).Range.text = "Replace"
    tbl.Cell(1, 8).Range.text = "Bold"
    
    ' Enter data for the first column
    For i = 2 To 10
        tbl.Cell(i, 1).Range.text = i - 1
    Next i
    
    ' Enter the data for the second column
    For i = 2 To 10
        tbl.Cell(i, 2).Range.text = "■"
    Next i
    
    ' Enter the data for the third column
    Dim col3Data As Variant
    col3Data = Array(255, 255, 190, 255, 0, 0, 153, 0, 0)
    For i = 2 To 10
        tbl.Cell(i, 3).Range.text = col3Data(i - 2)
    Next i
    
    ' Enter data for the fourth column
    Dim col4Data As Variant
    col4Data = Array(0, 0, 120, 0, 255, 0, 0, 200, 125)
    For i = 2 To 10
        tbl.Cell(i, 4).Range.text = col4Data(i - 2)
    Next i
    
    ' Enter data for the fifth column
    Dim col5Data As Variant
    col5Data = Array(0, 0, 0, 255, 0, 255, 255, 0, 255)
    For i = 2 To 10
        tbl.Cell(i, 5).Range.text = col5Data(i - 2)
    Next i
    
    ' Enter data for the 6th column
    Dim col6Data As Variant
    col6Data = Array("RGB color code", "Highlight strings", "Bold strings", "Coloring strings", "", "Replace strings", "Macro color", "Find strings", "")
    For i = 2 To 10
        tbl.Cell(i, 6).Range.text = col6Data(i - 2)
    Next i
    ' Enter data for the 7th column
    Dim col7Data As Variant
    col7Data = Array("", "", "", "", "", "", "", "", "")
    For i = 2 To 10
        tbl.Cell(i, 7).Range.text = col7Data(i - 2)
    Next i
    ' Enter data for the 8th column
    Dim col8Data As Variant
    col8Data = Array("", "y", "y", "", "", "", "y", "", "")
    For i = 2 To 10
        tbl.Cell(i, 8).Range.text = col8Data(i - 2)
    Next i
    '8) Set the rng (cursor) to the row two lines below the table.
    Set rng = tbl.Range
    rng.Collapse Direction:=wdCollapseEnd
    rng.Select
    '
    ' Set current document
    Set doc = ActiveDocument
    
    ' Set the font and size of the text
    With Selection.Font
        .Name = "Arial"
        .Size = 16
    End With
'
    Dim text1 As String
    text1 = "This Word VBA Macro color sets the RGB color code in the RGB color code table." & vbCrLf & _
            "You can also color strings using an RGB color code, as well as find and replace strings." & vbCrLf & _
            "" & vbCrLf & _
            "Furthermore, you can make specific text bold by setting it to bold in the table." & vbCrLf & _
            "" & vbCrLf & _
            "This allows you to Highlight strings in the text by coloring them or making them Bold strings."
    ' Set the text of the text box
    Dim textArray(1 To 16) As String
    textArray(1) = "Text input box"
    textArray(2) = text1
    textArray(3) = "Macro color flow chart"
    textArray(4) = "RGB color code setting"
    textArray(6) = "Find strings setting"
    textArray(8) = "Replace strings setting"
    textArray(10) = "Macro color execution"
    textArray(12) = "Coloring strings "
    textArray(14) = "Bold strings"
    textArray(16) = "Highlight strings"
    '
    Dim shp As Shape
    Dim leftPos As Single
    Dim topPos As Single
    Dim textBoxWidth As Single
    Dim textBoxHeight As Single
    'TXTBox
    i = 1
    topPos = 130 * 2.83465 + (i - 1) * 8 * 2.83465 ' Position at the specified position from the top
    leftPos = 10 * 2.83465 ' 100mm from the left
    textBoxWidth = 70 * 2.83465 ' Convert 70mm to points
    textBoxHeight = 10 * 2.83465 ' Convert 10mm to points
    '
    Set shp = doc.Shapes.AddTextbox(msoTextOrientationHorizontal, _
                                        leftPos, topPos, textBoxWidth, textBoxHeight)
    TXBShapeC shp, i, textArray(i)
    '
    i = 2
    topPos = 130 * 2.83465 + (i - 1) * 8 * 2.83465 ' Position at the specified position from the top
    leftPos = 10 * 2.83465 ' 100mm from the left
    textBoxWidth = 110 * 2.83465 ' Convert 70mm to points
    textBoxHeight = 100 * 2.83465 ' Convert 10mm to points
    '
    Set shp = doc.Shapes.AddTextbox(msoTextOrientationHorizontal, _
                                        leftPos, topPos, textBoxWidth, textBoxHeight)
    TXBShapeL shp, i, textArray(i)

    
    Set doc = ActiveDocument
    leftPos = 125 * 2.83465 ' 100mm from the left
    textBoxWidth = 70 * 2.83465 ' Convert 70mm to points
    textBoxHeight = 9 * 2.83465 ' Convert 10mm to points
    '
    For i = 3 To 16
        topPos = 130 * 2.83465 + (i - 3) * 7 * 2.83465 ' Position at the specified position from the top
        
        Set shp = doc.Shapes.AddTextbox(msoTextOrientationHorizontal, _
                                        leftPos, topPos, textBoxWidth, textBoxHeight)
        TXBShapeC shp, i, textArray(i)
    Next i
End Sub
Sub TXBShapeL(shp As Shape, i As Integer, text As String)
    With shp
        .Name = "TXB" & i
        .Line.Visible = msoTrue ' outer frame
        .Fill.Visible = msoFalse ' No fill
        .TextFrame.TextRange.text = text ' Text Settings
        .TextFrame.TextRange.ParagraphFormat.Alignment = wdAlignParagraphLeft ' Left aligned
        .TextFrame.TextRange.Font.Name = "Arial" ' Font Settings
        .TextFrame.TextRange.Font.Size = 16 ' Font size settings
        .TextFrame.TextRange.ParagraphFormat.LineSpacingRule = wdLineSpaceExactly ' Set line spacing to exact
        .TextFrame.TextRange.ParagraphFormat.LineSpacing = 20 ' Set line spacing to 20pt
        .TextFrame.MarginLeft = 3 ' Left margin 0mm
        .TextFrame.MarginRight = 0 ' Right margin 0mm
        .TextFrame.MarginTop = 0 ' Top margin 0mm
        .TextFrame.MarginBottom = 0 ' Bottom margin 0mm
    End With
End Sub
Sub TXBShapeC(shp As Shape, i As Integer, text As String)
    With shp
        .Name = "TXB" & i
        .Line.Visible = msoTrue ' outer frame
        .Fill.Visible = msoFalse ' No fill
        .TextFrame.TextRange.text = text ' Text Settings
        .TextFrame.TextRange.ParagraphFormat.Alignment = wdAlignParagraphCenter ' Centert aligned
        .TextFrame.TextRange.Font.Name = "Arial" ' Font Settings
        .TextFrame.TextRange.Font.Size = 16 ' Font size settings
        .TextFrame.TextRange.ParagraphFormat.LineSpacingRule = wdLineSpaceExactly ' Set line spacing to exact
        .TextFrame.TextRange.ParagraphFormat.LineSpacing = 20 ' Set line spacing to 20pt
        .TextFrame.MarginLeft = 0 ' Left margin 0mm
        .TextFrame.MarginRight = 0 ' Right margin 0mm
        .TextFrame.MarginTop = 0 ' Top margin 0mm
        .TextFrame.MarginBottom = 0 ' Bottom margin 0mm
        '
        If i = 1 Or i = 3 Then
            .Line.Visible = msoFalse ' No outer frame
        End If
        ' Settimg TXB2, TXB4, TXB6, TXB8 string
        If i >= 5 And i Mod 2 = 1 Then
            .Line.Visible = msoFalse ' No outer frame
            .TextFrame.TextRange.text = "↓"
        End If
    End With
End Sub

Place the cursor on the Sub Table_RGBsample_english() in the standard module Module 1. Then, select Run → Run the Sub User Form to run the Sub Table_RGBsample_english().

When you run the Sub Table_RGBsample_english(), an RGB color code table and a TextBox example will be created, as shown below.

2) Sub colorTable()

By running the Sub colorTable() macro, you can assign colors to the replacement strings in the RGB code table.

Plese copy the code for Sub colorTable() below into Module1 of the standard module.

Sub colorTable() ' Macro color for table
    'Dimension
    Dim RGB_R(9) As String 'Red RGB code Array
    Dim RGB_G(9) As String 'Green RGB code Array
    Dim RGB_B(9) As String 'Blue RGB code Array
    Dim RGB_V(9) As Long 'RGB code Array
    Dim FT(9) As String ' Find Text Array
    Dim RT(9) As String ' Replace Text Array
    Dim Bold_C7(9) As String ' Bold setting array at colum7
    Dim tbl As Table
    Dim rng As Range 'Set table range as rng
    ' Get table
    Set tbl = ActiveDocument.Tables(1)
    '
       For r = 2 To 10
        '1)ＲＧＢカラーコード表からＲＧＢカラーコードを取得(Get RGB color CODE)
        RGB_R(r - 1) = Left(tbl.Cell(Row:=r, Column:=3).Range.text, _
         Len(tbl.Cell(Row:=r, Column:=3).Range.text) - 2)
        RGB_G(r - 1) = Left(tbl.Cell(Row:=r, Column:=4).Range.text, _
         Len(tbl.Cell(Row:=r, Column:=4).Range.text) - 2)
        RGB_B(r - 1) = Left(tbl.Cell(Row:=r, Column:=5).Range.text, _
         Len(tbl.Cell(Row:=r, Column:=5).Range.text) - 2)
        '2) ＲＧＢカラーコードにより、カラー列のフォントカラーを設定
        '(Set font color of color column by RGB color code)
        RGB_V(r - 1) = RGB(RGB_R(r - 1), RGB_G(r - 1), RGB_B(r - 1))
        tbl.Cell(Row:=r, Column:=2).Range.Font.color = RGB_V(r - 1)
        '3) RGBカラーコード表から、検索文字列と置換文字列を取得
        '(Get search and replacement strings from the RGB color code table)
        FT(r - 1) = Left(tbl.Cell(Row:=r, Column:=6).Range.text, _
         Len(tbl.Cell(Row:=r, Column:=6).Range.text) - 2)
        RT(r - 1) = Left(tbl.Cell(Row:=r, Column:=7).Range.text, _
         Len(tbl.Cell(Row:=r, Column:=7).Range.text) - 2)
      
        '4) 置換文字列が空の場合、検索0文字列を置換文字列に入力
        '(If the replacement string is empty, enter the search string into the replacement string.)
            If Trim(RT(r - 1)) = "" Then
                tbl.Cell(Row:=r, Column:=7).Range.text = FT(r - 1)
                RT(r - 1) = FT(r - 1)
            Else
        '
            End If
        '5) 置換文字列（７列）にカラー列（２列）の色を配色
        '(Color the replacement string (7 columns) with the color column (2 columns))
        tbl.Cell(Row:=r, Column:=7).Range.Font.color = RGB_V(r - 1)
        '6) 表の8列目のセルがYなら、表の７列目の置換文字列をBoldに設定
        ' セルのテキストにYが含まれるかチェック(Check if cell text contains Y)
            If InStr(1, tbl.Cell(Row:=r, Column:=8).Range.text, "Y", vbTextCompare) > 0 Then
                ' Yが含まれる場合は7列目のセルをBoldにする(Make cell in column 7 Bold if it contains Y)
                tbl.Cell(Row:=r, Column:=7).Range.Font.Bold = True
            Else
                ' Yが含まれない場合はBoldを解除する(If Y is not included, turn off Bold.)
                tbl.Cell(Row:=r, Column:=7).Range.Font.Bold = False
            End If
 
        '
        '7)　7列目が太字になっているか確認(Check 7th colum is Bold)
        Bold_C7(r - 1) = tbl.Cell(Row:=r, Column:=7).Range.Font.Bold
      Next r
End Sub

Place the cursor on the Sub colorTable() in the standard module Module 1. Then, select Run → Run the Sub User Form to run the Sub colorTable().

By executing the Sub colorTable(), you can assign the color of the color column to the Replace column, as shown below.

Introduction of Sub colorTxBox()

By executing the sub colorTxBox() which is in the paid article., you can color the strings in the text boxes, as shown below.

Folloring Sample code for Sub colorTxBox() is in the paid article.