How to i change the font color of specific text in a shape textframe? VBA-CodePudding

I am trying to change the font color of specific text within a shape textframe (Multiple occurrence of the text within the same frame). This is what I currently have.

And this is what i am trying to achieve.

Basically finding the word "Capital:" and selecting that until the next space and changing it to the color red. (ex: Capital:Boston, Capital:Neveda, Capital:NewJersey).

The code i already have is this.

With OrgChart
With .Shapes("ChartItem" & OrgID).GroupItems("OrgTitle")
    .TextFrame2.TextRange.Characters(1, 2).Font.Fill.ForeColor.RGB = RGB(255, 0, 255)
End With
End With

I need help with Character(x,x) feature - maybe an InStr function... not sure how that would work.

CodePudding user response：

RegEx is a great choice for pattern matching the patterns on a PC.

Sub TestRegX()
    Const Pattern As String = "Capital:*([^\s] )"
    Dim Shape As Shape
    Set Shape = ActiveSheet.Shapes(1)
    HighLightTextFrame2Matches Shape.TextFrame2, Pattern, RGB(255, 0, 255)
End Sub

Sub HighLightTextFrame2Matches(TextFrame2 As TextFrame2, Pattern As String, RGB As Long)
    Dim RegX As Object
    Set RegX = CreateObject("VBScript.RegExp")
    
    With RegX
        .Global = True
        .MultiLine = True
        .Pattern = Pattern
    End With
    
    With TextFrame2.TextRange
        If RegX.Test(.Text) Then
            Dim Match As Match
            For Each Match In RegX.Execute(.Text)
                .Characters(Match.FirstIndex   1, Match.Length).Font.Fill.ForeColor.RGB = RGB
            Next
        End If
    End With
End Sub

InStr will work on both MAC and PCs.

Sub TestHighLightTextFrameSplit()
    Const Match As String = "Capital:"
    Dim Shape As Shape
    Set Shape = ActiveSheet.Shapes(1)
    HighLightTextFrameMatch Shape.TextFrame2, Match, RGB(255, 0, 255)
End Sub

Sub HighLightTextFrameMatch(TextFrame2 As TextFrame2, Match As String, RGB As Long)
    Dim FirstIndex As Long, LastIndex As Long, Length As Long
    FirstIndex = 1
    With TextFrame2.TextRange
        While InStr(FirstIndex, .Text, Match) > 0
            FirstIndex = InStr(FirstIndex, .Text, Match)
            LastIndex = InStr(FirstIndex, .Text, " ")
            Length = LastIndex - FirstIndex
            .Characters(FirstIndex, Length).Font.Fill.ForeColor.RGB = RGB
            FirstIndex = FirstIndex   1
        Wend
    End With
End Sub