vba 用于突出显示多个单词的 Microsoft Word 宏

Microsoft Word Macro for highlighting multiple words

提问by Taylor Kline

My intent is to create a very basic macro to find a series of words and highlight them. Unfortunately, I do not know how to do multiple words in one step. For example, the following code works:

我的目的是创建一个非常基本的宏来查找一系列单词并突出显示它们。不幸的是，我不知道如何一步完成多个单词。例如，以下代码有效：

Sub Macro1()
'
' Macro1 Macro
'
'
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    Selection.Find.Replacement.Highlight = True
    With Selection.Find
        .Text = "MJ:"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = True
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
End Sub

However, if I add in another .Text =line, then the MJ:is ignored. Any ideas?

但是，如果我添加另一.Text =行，则MJ:忽略 。有任何想法吗？

采纳答案by subcortical

If you are only looking for a few words simply doing multiple find and replaces within the same macro will accomplish what you want. For example, the following will highlight in yellow all occurrences of "target1" and "target2"

如果您只查找几个单词，只需在同一个宏中进行多次查找和替换即可完成您想要的操作。例如，以下将以黄色突出显示所有出现的“target1”和“target2”

Sub HighlightTargets()

' --------CODE TO HIGHLIGHT TARGET 1-------------------
    Options.DefaultHighlightColorIndex = wdYellow
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    Selection.Find.Replacement.Highlight = True
    With Selection.Find
        .Text = "target1"
        .Replacement.Text = "target1"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll

' --------CODE TO HIGHLIGHT TARGET 1-------------------
    Options.DefaultHighlightColorIndex = wdYellow
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    Selection.Find.Replacement.Highlight = True
    With Selection.Find
        .Text = "target2"
        .Replacement.Text = "target2"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
End Sub

Alternatively the following code will let you add all the terms to highlight in one line which may be easier to work with.

或者，以下代码将让您将所有术语添加到一行中突出显示，这可能更容易使用。

Sub HighlightTargets2()

Dim range As range
Dim i As Long
Dim TargetList

TargetList = Array("target1", "target2", "target3") ' put list of terms to find here

For i = 0 To UBound(TargetList)

Set range = ActiveDocument.range

With range.Find
.Text = TargetList(i)
.Format = True
.MatchCase = True
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False

Do While .Execute(Forward:=True) = True
range.HighlightColorIndex = wdYellow

Loop

End With
Next

End Sub

回答by The Saj

I had done the following modification. Perhaps not as elegant as the array. But I was thinking along the lines of a user simply pasting a list of values into a field.

我做了以下修改。也许不如数组优雅。但我正在考虑用户只是将值列表粘贴到字段中。

Sub HighlightKeyword(SearchWord As String)
'
' HighlightKeyword Macro
'
    Options.DefaultHighlightColorIndex = wdYellow
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    Selection.Find.Replacement.Highlight = True
    With Selection.Find
        .Text = SearchWord
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = True
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
End Sub

Sub HighlightKeywordList()
'
' HighlightKeywordList 
'
'
    Dim HighlightList As String
    Dim WordList As Variant

    HighlightList = "Lorem Ipsum,amit,Finibus,Bonorum,et Malorum,Vestibulum,Vivamus,Integer"
    WordList = Split(HighlightList, ",")

    For i = 0 To UBound(WordList)

        HighlightKeyword (WordList(i))
    Next i

End Sub