Добавление к каждому конкретному слову в документе Word

Question

Я хочу добавить комментарий и изменить цвет шрифта на красный для каждого экземпляра определенного слова, найденного в тексте. Используя Selection.Find, я могу изменить только цвет шрифта на красный - есть ли способ добавить комментарий к каждому найденному слову?

Sub WordSearcher(word)
  Selection.Find.ClearFormatting
  Selection.Find.Replacement.ClearFormatting
  Selection.Find.Replacement.Font.Color = wdColorGreen
  With Selection.Find
        .Text = word
        '.Replacement.Text = word
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = True
  End With
  Selection.Find.Execute Replace:=wdReplaceAll
End Sub

Я написал приведенный ниже код, который выполняет обе задачи, но он не очень эффективен, поскольку для просмотра всего документа требуется несколько минут - есть ли способ сделать это в более разумное время?

For i = 1 To ActiveDocument.Words.Count
        For j = 0 To UBound(arrWords)
            If Trim(UCase(ActiveDocument.Words(i))) = UCase(arrWords(j)) Then
                ActiveDocument.Words(i).Font.Color = vbRed
                ActiveDocument.Comments.Add ActiveDocument.Range(ActiveDocument.Words(i).Start, ActiveDocument.Words(i).End), arrComments(j)
            End If
        Next j
Next

Answer 1

Да, это возможно. Это включает прерывание поиска в каждом «найденном» для добавления комментария. Чтобы сделать это эффективно, лучше работать с Range объектом, а не с Selection.

Метод Find.Execute возвращает логическое значение: true при успешном поиске. Вы можете использовать это, чтобы проверить, должен ли быть вставлен комментарий, а также чтобы узнать, когда код должен остановиться.

Обратите внимание, что также важно использовать Find.Wrap = wdFindStop, чтобы избежать зацикливания кода "бесконечно".

Sub FindRedAndComment()
    Dim rngFind As word.Range
    Dim doc As word.Document
    Dim sFindText As String
    Dim sCommentText As String
    Dim bFound As Boolean

    Set doc = ActiveDocument
    Set rngFind = doc.content
    sFindText = "test"
    sCommentText = "comment"
    With rngFind.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Replacement.Font.Color = wdColorRed
        .Text = sFindText
        .Forward = True
        .wrap = wdFindStop
        .Format = True
        .MatchCase = False
        .MatchWholeWord = True
        bFound = .Execute(Replace:=wdReplaceOne)
  End With
  Do Until Not bFound
      If bFound Then
        doc.Comments.Add rngFind, sCommentText
        rngFind.Collapse wdCollapseEnd
        rngFind.End = doc.content.End
        bFound = rngFind.Find.Execute(Replace:=wdReplaceOne)
      End If
  Loop
End Sub