MS Word VBA - поиск слова и изменение его стиля

Question

Я пытаюсь найти все экземпляры ключевых слов в документе MS Word и изменить их стиль. Ключевые слова хранятся в массиве, и я хочу изменить стиль только конкретного слова. В идеале это должно происходить, когда я печатаю, но это не принципиально.

Попытка 1 - на основе записи макроса и изменения условия поиска

Sub Woohoo()
Dim mykeywords
mykeywords= Array("word1","word2","word3")

For myword= LBound(mykeywords) To UBound(mykeywords)

    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    Selection.Find.Replacement.Style = ActiveDocument.Styles("NewStyle")
    With Selection.Find
        .Text = mykeywords(myword)
        .Replacement.Text = mykeywords(myword)
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = True
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
Next

End Sub

Это меняет стиль всего абзаца, в котором находятся слова.

Попытка 2 - на основе этого вопроса здесь Как я могу заменить стиль символа Microsoft Word в пределах диапазона / выделения в VBA?:

Sub FnR2()
Dim rng As Range
Dim mykeywords
mykeywords = Array("word1","word2","word3")

For nKey = LBound(mykeywords) To UBound(mykeywords)
For Each rng In ActiveDocument.Words
    If IsInArray(rng, mykeywords(nKey)) Then
        rng.Style = ActiveDocument.Styles("NewStyle")
    End If
Next
Next

End Sub

Он находит слова в одной строке, но по какой-то причине пропускает слова внутри абзаца, например, находит

Some text
word1
more text

но нет

Some text before word1 means that the code above doesn't change the format
Word1 also isn't changed in this instance

Попытка 3 - автозамена; на самом деле не пробовал:

В качестве альтернативы я думал использовать автозамену. Однако у меня есть более 100 ключевых слов и я не знаю, как добавить это в список автозамены автоматически (я довольно неграмотный VBA). Другая проблема, с которой я столкнулся бы при таком подходе, заключается в том, что я считаю, что автозамена является глобальной, тогда как это нужно только для работы с конкретным документом.

Answer 1

Я считаю, что причина, по которой ваш макрос не находит слова, связана с наличием пробелов в начале или в конце. При условии, что вы уже определили стиль "NewStyle", изменив оператор if в SubFnR2 с

If IsInArray(rng, mykeywords(nKey)) Then

в

If mykeywords(nkey) = LCase(Trim(rng.Text)) Then

Должен решить вопрос. Кстати, если вы хотите сохранить стиль слова в зависимости от того, является ли он верхним или нижним регистром, то удалите часть LCase.

Редактировать:

Я включил саб с модификацией ниже. Я проверил его на приведенных вами примерах (вырезал и вставил в слово), и он изменил стиль для обоих экземпляров word1.

Sub FnR3()
Dim rng As Range
Dim mykeywords
mykeywords = Array("word1", "word2", "word3")
Dim nkey As Integer

For nkey = LBound(mykeywords) To UBound(mykeywords)
For Each rng In ActiveDocument.Words

    If mykeywords(nkey) = LCase(Trim(rng.Text)) Then
        rng.Style = ActiveDocument.Styles("NewStyle")
    End If

Next rng
Next nkey

End Sub

Хорошо, ваш документ ведет себя так, как вы описали, я не совсем уверен, почему. Я проверил выбор диапазона, и было выбрано только слово, но затем был отформатирован весь абзац. Я изменил код для изменения выбора, показанного ниже. Это просто изменило слово.

Sub FnR4()
Dim rng As Range
Dim mykeywords
mykeywords = Array("word1", "word2", "word3")
Dim nkey As Integer

For nkey = LBound(mykeywords) To UBound(mykeywords)
    For Each rng In ActiveDocument.Words
        Selection.Collapse
        rng.Select
            If mykeywords(nkey) = LCase(Trim(rng.Text)) Then
                Selection.Style = ActiveDocument.Styles("NewStyle")
            End If

    Next rng
Next nkey

End Sub