MS Word VBA - 查找单词并更改其样式

MS Word VBA - Finding a word and changing its style

提问by pandita

I'm trying to find all instances of key words in a MS Word document and change their style. The key words are stored within an array and I want to change the style of the particular word only. Ideally this would happen as I type but that is not crucial.

我正在尝试在 MS Word 文档中查找关键字的所有实例并更改它们的样式。关键字存储在一个数组中，我只想更改特定单词的样式。理想情况下，这会在我输入时发生，但这并不重要。

Attempt 1 - Based on recording a macro and changing the search term

尝试 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

This changes the style of the entire paragraph where the words are in.

这会更改单词所在的整个段落的样式。

Attempt 2 - Based on this question here How can I replace a Microsoft Word character style within a range/selection in VBA?:

尝试 2 - 基于这里的这个问题如何在 VBA 中的范围/选择中替换 Microsoft Word 字符样式？：

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

This finds words that are in single lines but skips the words that are within a paragraph for some reason, e.g. it finds

这会找到单行的单词，但由于某种原因跳过段落内的单词，例如它会找到

Some text
word1
more text

but not

但不是

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

Attempt 3 - AutoCorrect; not actually tried:

尝试 3 - 自动更正；没有真正尝试过：

As an alternative I was thinking to use AutoCorrect. However I have more than 100 keywords and have no idea how to add this to the AutoCorrect list automatically (I'm fairly VBA illiterate). The other problem I would see with this approach is that I believe that AutoCorrect is global, whereas I need this only to work for a specific document.

作为替代方案，我正在考虑使用自动更正。但是，我有 100 多个关键字，并且不知道如何自动将其添加到自动更正列表中（我对 VBA 不太了解）。我会用这种方法看到的另一个问题是，我相信自动更正是全局的，而我只需要它来处理特定文档。

采纳答案by Graham Anderson

I believe the reason why your macro isn't finding the words is due to the presence of leading or trailing blank spaces. Providing that you have already defined the style "NewStyle" changing your if statement in SubFnR2 from

我相信您的宏找不到单词的原因是由于存在前导或尾随空格。假设您已经定义了样式“NewStyle”，将 SubFnR2 中的 if 语句从

If IsInArray(rng, mykeywords(nKey)) Then

to

到

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

Should solve the issue. By the way if you want to keep the style of the word depending on whether it is upper or lower case then remove the LCase part.

应该可以解决问题。顺便说一句，如果您想根据单词是大写还是小写来保留单词的样式，请删除 LCase 部分。

Edit:

编辑：

I have included the sub with the modification below. I have tested it on the examples you gave (cut and pasted into word) and it changed the style for both instances word1.

我已经包含了下面的修改子。我已经在您提供的示例上对其进行了测试（剪切并粘贴到 word 中），并且它更改了两个实例 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

Ok, your document behaves has you described, I'm not quite sure why. I checked selecting the range and just the word was selected, but then the whole paragraph was formatted. I have modified the code to modify the selection, shown below. This did just change the word.

好的，你的文件表现有你描述的，我不太确定为什么。我检查了选择范围，只选择了单词，但是整个段落都被格式化了。我已经修改了代码来修改选择，如下所示。这只是改变了这个词。

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