Word-VBA:在特定范围内应用阴影?

时间:2018-11-12 15:00:13

标签: vba ms-word

我创建了一个用于在一系列文档中查找文本的函数,并在找到的文本上加上阴影。 我按以下方式运行代码,但是它将找到整个文档文本并应用阴影。

文档如下: enter image description here

如何使该功能起作用?谢谢!

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

1 个答案:

答案 0 :(得分:0)

帮自己一些忙。

  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