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 - 基於這個問題，在這裏How can I replace a Microsoft Word character style within a range/selection in 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文盲）。我會用這種方法看到的另一個問題是，我相信AutoCorrect是全球性的，而我只需要這樣做就可以用於特定的文檔。

Answer 1

我相信你的宏沒有找到單詞的原因是由於存在前導或尾隨空格。提供您已經定義的樣式「NewStyle」改變SubFnR2您的if語句從

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