Removing text between 2 specific colored brackets-CodePudding

I am trying to create a VBA code for word that will search for a specific colored square bracket and then search for the corresponding closing bracket of that color and delete all text between these 2 colored bracket.

enter image description here

The code will search for a green square opening bracket then search for the green closing bracket and delete everything in between which in this case will be "brown fox". I will then add update the code for the color of the red bracket and have it delete everything between the red bracket. I have found the following code from another question on this site and this does work 90% but i cant get it to search for the specific colored bracket.

I tried

.Format = True   .Font.Color = WdColorRed

but it doesnt pick it up. Any help is appreciated. Thanks

Sub FindSquareBracketPairs()
Dim rngFind As Word.Range
Dim sOpen As String, sClose As String
Dim sFindTerm As String
Dim bFound As Boolean, lPosOpen As Long

Set rngFind = ActiveDocument.Content
sOpen = "["
sClose = "]"
sFindTerm = "\[*\] "

With rngFind.Find
    .ClearFormatting
    .Text = "\[*\] "
    .Forward = True
    .Wrap = Word.WdFindWrap.wdFindStop
    .MatchWildcards = True
    bFound = .Execute

    Do While bFound
        lPosOpen = NumberOfCharInRange(rngFind, sOpen)
        rngFind.Delete
        rngFind.Collapse wdCollapseEnd
        bFound = .Execute
    Loop
End With
End Sub
'Checks whether there's more than one instance of searchTerm in the rng.Text
'For each instance above one, move the Start point of the range
'To the position of that instance until no more are "found".
'Since the Range is passed ByRef this will change the original
'range's position in the calling procedure.
Function NumberOfCharInRange(ByRef rng As Word.Range, _
                         ByRef searchTerm As String) As Long
Dim lCountChars As Long, lCharPos As Long
Dim s As String

s = rng.Text
Do
    lCharPos = InStr(s, searchTerm)
    If lCharPos > 1 Then
        lCountChars = lCountChars   1
        rng.Start = rng.Start   lCharPos
    End If
        s = Mid(s, lCharPos   1)
Loop Until lCharPos = 0
NumberOfCharInRange = lCountChars
End Function

CodePudding user response：

You'll want to get the Color from the Font of the range. Then use this website to use decimal you get or transfer/convert to hex or rgb someway. There are also constants in VBA such as wdRed but, it's the word red whatever that is.

Sub FindSquareBracketPairs()
Dim rngFind As Range
Dim sOpen As String, sClose As String
Dim sFindTerm As String
Dim bFound As Boolean, lPosOpen As Long
Set rngFind = ActiveDocument.Range
sOpen = "["
sClose = "]"
sFindTerm = "\[*\] "

For Each rng In ActiveDocument.StoryRanges
    For Each rngChar In rng.Characters
        Dim fnt As Font
        Set fnt = rngChar.Font
        Dim clr As WdColor
        clr = rngChar.Font.Color
    Next
Next

With rngFind.Find
    '.ClearFormatting
    .Text = "\[*\] "
    .Forward = True
    .Wrap = Word.WdFindWrap.wdFindStop
    .MatchWildcards = True
    bFound = .Execute

    Do While bFound
        lPosOpen = NumberOfCharInRange(rngFind, sOpen)
'Check if the first and last brackets are whatever color is passed here.
        If (IsSurroundedByColor(wdColorRed, rngFind.Characters.First, rngFind.Characters(rngFind.Characters.Count - 1))) Then
            rngFind.Delete
        End If
        rngFind.Collapse wdCollapseEnd
        bFound = .Execute
    Loop
End With
End Sub

Function IsSurroundedByColor(ByRef chkingClr As WdColor, ByRef frstChr As Range, ByRef lstChr As Range) As Boolean
    IsSurroundedByColor = (frstChr.Font.Color = chkingClr And lstChr.Font.Color = chkingClr)
End Function