Word-VBA：在特定范围内应用阴影？

Question

我创建了一个函数，用于在一系列文档中查找文本，并在找到时对文本应用阴影。 我运行代码如下，但它会找到整个文档文本并应用阴影。

文件如下：

如何使该功能起作用？谢谢！

Public Function myFun_findTxt2addShading( _
            str_findTxt As String, _
            range_myRange, _
            str_repTxt As String, _
            str_ShadingColor As String) As Boolean

Dim boolean_checkFound As Boolean
boolean_checkFound = False

range_myRange.Select
With Selection
    .Find.ClearFormatting
    .Find.Replacement.ClearFormatting
    .Find.Text = str_findTxt
    .Find.Replacement.Text = str_repTxt
    .Find.Forward = True
    .Find.Replacement.Font.ColorIndex = str_RepFontColor
    .Find.Wrap = wdFindStop
    Do While .Find.Execute
        Selection.Shading.Texture = wdTextureNone
        Selection.Shading.ForegroundPatternColor = wdColorAutomatic
        Selection.Shading.BackgroundPatternColor = str_ShadingColor
        boolean_check = True
    Loop
    .Find.Format = False
    .Find.MatchCase = False
    .Find.MatchWholeWord = False
    .Find.MatchByte = False
    .Find.MatchWildcards = False
    .Find.MatchSoundsLike = False
    .Find.MatchAllWordForms = False

End With
findTxt_Shading = boolean_checkFound
End Function

Sub test()
With Selection
    .HomeKey Unit:=wdStory
    .Find.Execute findText:="bookmark1", Forward:=True, Wrap:=wdFindStop
    .MoveDown Unit:=wdLine
    .HomeKey Unit:=wdLine
     ActiveDocument.Bookmarks.Add Range:=Selection.Range, Name:="sybStart"
    .Find.Execute findText:="bookmark2", Forward:=True, Wrap:=wdFindStop
    .HomeKey Unit:=wdLine
     ActiveDocument.Bookmarks.Add Range:=Selection.Range, Name:="sybEnd"
End With
Set sybRange = ActiveDocument.Range
sybRange.Start = sybRange.Bookmarks("sybStart").Range.End
sybRange.End = sybRange.Bookmarks("sybEnd").Range.Start

a = myFun_findTxt2addShading("pp", sybRange, "pp", wdColorYellow)
End Sub

Answer 1

帮自己一些忙。

1. 将“选项显式”放在每个模块的顶部。

2. 在 VBA IDE 中转到 Tools.Options.Editor 并确保选中代码设置组中的所有框。

3. 在 VBA IDE 中，将光标放在关键字上并按 F1 会打开该关键字的 MS 帮助页面。试试 .Find 方法。

我稍微整理了您的代码并使用了更明智的命名（只是更明智一点）。下面的代码现在将突出显示文档中所选内容中的每个单词。

请注意，我特意使用了两个进行分组，以便您每次找到 findTxt 时都可以执行其他操作。如果您只是想突出显示文本，您可以省略第二个 With 组并将 .Format 从 False 更改为 True。

Public Function AddShadingToFoundText( _
            findTxt As String, _
            repTxt As String, _
            ShadingColor As WdColor) As Boolean

    Dim findTxtFound As Boolean

    findTxtFound = False

    If myRange.Characters.Count < Len(findTxt) Then
        ' No point in searching if the selected text is
        ' smaller than the search text.
        Exit Function

    End if

    With myRange.Duplicate
        With .Find
            .ClearFormatting
            .Replacement.ClearFormatting
            .Text = findTxt
            .Replacement.Text = findTxt
            .Forward = True
            ' str_RepFontColor
            '.Find.Replacement.Font.ColorIndex = str_RepFontColor
            .Wrap = wdFindStop
            .Format = False
            .MatchCase = False
            .MatchWholeWord = False
            .MatchByte = False
            .MatchWildcards = False
            .MatchSoundsLike = False
            .MatchAllWordForms = False
            .Execute

        End With

        ' Make sure there is still room for the search text
        Do While .Find.Found And .Start < myRange.End - Len(findTxt)
            .Shading.Texture = wdTextureNone
            .Shading.ForegroundPatternColor = WdColor.wdColorAutomatic
            .Shading.BackgroundPatternColor = ShadingColor
            .Collapse Direction:=wdCollapseEnd
            .Move unit:=wdCharacter, Count:=1
            .Find.Execute
            findTxtFound = True

        Loop

    End With

    AddShadingToFoundText = findTxtFound

End Function

Sub test()
Dim a As Boolean
a = AddShadingToFoundText("row", Selection.Range, "row", WdColor.wdColorRed)

End Sub