Word VBA宏用5种不同的颜色突出显示相同的样式

Question

我需要做一个宏来找到一个特定风格的所有出现(他们都是标题，共享相同的风格)，然后在5个不同的颜色顺序突出。我已经有一段代码来做这件事了，但是我需要在文档的末尾重复这一步。我知道代码是非常粗糙的，所以如果有人能帮助我使它更短，更有效率，我也将不胜感激。

Sub Highlight()
'
' highlight Macro
'
'
    Selection.HomeKey Unit:=wdStory
    Options.DefaultHighlightColorIndex = wdYellow
    Selection.Find.ClearFormatting
    Selection.Find.Style = ActiveDocument.Styles("Rashi Char")
Selection.Find.Replacement.ClearFormatting
Selection.Find.Replacement.Highlight = True
With Selection.Find
    .Text = ""
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindAsk
    .Format = True
    .MatchCase = False
    .MatchWholeWord = False
    .MatchKashida = False
    .MatchDiacritics = False
    .MatchAlefHamza = False
    .MatchControl = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceOne
Options.DefaultHighlightColorIndex = wdBrightGreen
Selection.Find.ClearFormatting
Selection.Find.Style = ActiveDocument.Styles("Rashi Char")
Selection.Find.Replacement.ClearFormatting
Selection.Find.Replacement.Highlight = True
With Selection.Find
    .Text = ""
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindAsk
    .Format = True
    .MatchCase = False
    .MatchWholeWord = False
    .MatchKashida = False
    .MatchDiacritics = False
    .MatchAlefHamza = False
    .MatchControl = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceOne
Options.DefaultHighlightColorIndex = wdTurquoise
    Selection.Find.ClearFormatting
Selection.Find.Style = ActiveDocument.Styles("Rashi Char")
Selection.Find.Replacement.ClearFormatting
Selection.Find.Replacement.Highlight = True
With Selection.Find
    .Text = ""
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindAsk
    .Format = True
    .MatchCase = False
    .MatchWholeWord = False
    .MatchKashida = False
    .MatchDiacritics = False
    .MatchAlefHamza = False
    .MatchControl = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceOne
Options.DefaultHighlightColorIndex = wdPink
    Selection.Find.ClearFormatting
Selection.Find.Style = ActiveDocument.Styles("Rashi Char")
Selection.Find.Replacement.ClearFormatting
Selection.Find.Replacement.Highlight = True
With Selection.Find
    .Text = ""
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindAsk
    .Format = True
    .MatchCase = False
    .MatchWholeWord = False
    .MatchKashida = False
    .MatchDiacritics = False
    .MatchAlefHamza = False
    .MatchControl = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceOne
Options.DefaultHighlightColorIndex = wdGreen
Selection.Find.ClearFormatting
Selection.Find.Style = ActiveDocument.Styles("Rashi Char")
Selection.Find.Replacement.ClearFormatting
Selection.Find.Replacement.Highlight = True
With Selection.Find
    .Text = ""
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindAsk
    .Format = True
    .MatchCase = False
    .MatchWholeWord = False
    .MatchKashida = False
    .MatchDiacritics = False
    .MatchAlefHamza = False
    .MatchControl = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceOne

End Sub

Answer 1

有两种方法。我将对这两种方法进行简要描述。

1. 将所有不会从一个迭代更改到另一个迭代的属性放在代码顶部附近进行分组。你不需要每次都设置这些东西，一次就足够了。我说的是With Selection.Find ... End With结构中的几乎所有东西。然后，您可以删除不需要的重复代码。这将大大缩短您的代码。

使用选择对象时，所做的设置会影响“查找”对话框。因此它们会一直存在，直到您(或其他代码)更改它们。这就是为什么这对你来说是有效的。

1. 另一种方法是将重复的代码放在它自己的过程中。为您想要的每个迭代调用该过程。为了更改某些特征，需要定义一个或多个参数并传递该信息。

例如，您可以传递要搜索的样式名称和高亮颜色。方法签名将类似于：

Sub FindAndHighlight(TextToFind as String, HighlightColor as Long)

你可以这样称呼它：

FindAndHighlight "Rashi Char", wdGreen

这将有助于缩短您的代码(并使其更容易阅读)，因为它将所有重复的操作放在一个位置，因此您只需编写一次。

Answer 2

您想要使用的是Do While，请参见下面的脚本。

Sub Highlight()
'
' highlight Macro
'
'
'Going to the top of the Document
Selection.HomeKey Unit:=wdStory

'Setting up your Selection.Find
With Selection.find
    .text = ""
    .Replacement.text = ""
    .style = ActiveDocument.Styles("Rashi Char")
    .Forward = True
    .Wrap = wdFindAsk
    .Format = True
    .MatchCase = False
    .MatchWholeWord = False
    .MatchKashida = False
    .MatchDiacritics = False
    .MatchAlefHamza = False
    .MatchControl = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False

    'Setting your counter for selecting which colour for highlighting
    d = 1

    'Executing the search
    Do While .Execute

        'If d = 1 then its 1 of 5
        If d = 1 Then
            Selection.Range.HighlightColorIndex = wdYellow
        'If d = 2 then its 2 of 5
        ElseIf d = 2 Then
            Selection.Range.HighlightColorIndex = wdBrightGreen
        'If d = 3 then its 3 of 5
        ElseIf d = 3 Then
            Selection.Range.HighlightColorIndex = wdTurquoise
        'If d = 4 then its 4 of 5
        ElseIf d = 4 Then
            Selection.Range.HighlightColorIndex = wdPink
        'If d = 5 then its 5 of 5
        ElseIf d = 5 Then
            Selection.Range.HighlightColorIndex = wdGreen
        End If
        'Incrementing d
        d = d + 1
        'If d = 6 then you have completed the highlighting loop
        'Then set d back to 1
        If d = 6 Then d = 1

     Loop
'Ending the Selectin.Find With
End With

End Sub

我使用Header 1作为我的.style进行了测试，它工作得很好。