макрос слова, чтобы выделить наборы слов в разных цветах

Question

У меня есть макрос Word, который я недавно настроил у кого-то другого (к сожалению, я не могу найти источник). Цель состоит в том, чтобы выделить все вхождения "он" и "его" в бирюзовый, и все вхождения "она" и "ее" в розовый. Он работает частично - он выделяет "он" (но не "его") на бирюзовом, а "она" (но не "ее") на розовом.

Что я делаю неправильно?

Sub HighLightHeShe()
    Dim vFindText As Variant
    Dim oRng As Range
    Dim i As Long
    vFindText = Array("he", "his")
    Set oRng = ActiveDocument.Range
    With oRng.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        Do While .Execute(FindText:=vFindText(i), _
                          MatchWholeWord:=True, _
                          Forward:=True, _
                          Wrap:=wdFindStop) = True
            oRng.HighlightColorIndex = wdTurquoise
            oRng.Collapse wdCollapseEnd
        Loop
    End With
    vFindText = Array("she", "her")
    Set oRng = ActiveDocument.Range
    With oRng.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        Do While .Execute(FindText:=vFindText(i), _
                          MatchWholeWord:=True, _
                          Forward:=True, _
                          Wrap:=wdFindStop) = True
            oRng.HighlightColorIndex = wdPink
            oRng.Collapse wdCollapseEnd
        Loop
    End With
lbl_Exit:
    Exit Sub
End Sub

Answer 1

Причина, по которой вы находите только первый элемент в каждом массиве, заключается в том, что вы не меняете значение "i". Вам нужно обернуть "Находки" в петлю.

Увидеть ниже ...

Sub HighLightHeShe()
    Dim vFindText As Variant
    Dim oRng As Range
    Dim i As Long

    vFindText = Array("he", "his")
    For i = 0 To UBound(vFindText)
        Set oRng = ActiveDocument.Range
        With oRng.Find
            .ClearFormatting
            .Replacement.ClearFormatting
            Do While .Execute(FindText:=vFindText(i), _
                              MatchWholeWord:=True, _
                              Forward:=True, _
                              Wrap:=wdFindStop) = True
                oRng.HighlightColorIndex = wdTurquoise
                oRng.Collapse wdCollapseEnd
            Loop
        End With
    Next

    vFindText = Array("she", "her")
    For i = 0 To UBound(vFindText)
        Set oRng = ActiveDocument.Range
        With oRng.Find
            .ClearFormatting
            .Replacement.ClearFormatting
            Do While .Execute(FindText:=vFindText(i), _
                              MatchWholeWord:=True, _
                              Forward:=True, _
                              Wrap:=wdFindStop) = True
                oRng.HighlightColorIndex = wdPink
                oRng.Collapse wdCollapseEnd
            Loop
        End With
    Next

lbl_Exit:
    Exit Sub
End Sub