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 перейдите Инструменты.Options.Editor и убедитесь, что отмечены все поля в группе «Параметры кода».

3. В VBA IDE, поместив курсор на ключевое слово и нажав клавишу F1, открывается страница справки MS.для этого ключевого слова.Попробуйте его для метода .Find.

Я немного прибрался в вашем коде и использовал более разумные названия (только чуть более разумные).Приведенный ниже код теперь будет выделять каждое слово в выделении в документе.

Обратите внимание, что я намеренно использовал два слова с группировками, чтобы вы могли выполнять другие действия при каждом обнаружении findTxt.Если вы просто хотите выделить текст, вы можете опустить вторую с группой и изменить .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