Поиск текста, применение цвета фона в нескольких ячейках

Question

Может ли кто-нибудь объяснить мне, как я адаптирую этот рабочий код, чтобы он мог выполнять эти две разные вещи: 1) Также выберите ячейку ниже ячейки с найденным текстом и примените тот же цвет фона к новой ячейке.2) Также выберите ячейку ниже ячейки с найденным текстом и примените цвет к шрифту.

Sub ScratchMacro()
Dim r As Range
Dim oRng As Word.Range
Dim wdOrange As Long
Red = 255
Purple = 16711875
Black = 0
Pink = 11796735
Blue = 16711680
Orange = 41215
Green = 1954333
Yellow = 60671
Set r = ActiveDocument.Range
With r.Find
    Do While .Execute(FindText:="The Text You are Searching For", MatchWholeWord:=True, Forward:=True)
      If r.Information(wdWithInTable) Then
        If r.InRange(r.Cells(1).Range) Then
        r.Cells(1).Shading.BackgroundPatternColor = Yellow
        End If
      End If
    Loop
End With
End Sub

Большое спасибо!

Answer 1

Хитрость заключается в том, чтобы получить индекс строки и столбца из «найденной» ячейки, увеличить индекс строки на единицу и использовать его для идентификации ячейки в таблице.

Обратите внимание, что это хорошая идеяпоместите Option Explicit вверху всех кодовых «страниц», что означает, что все имена переменных должны быть объявлены.Я использую это, поэтому все эти цвета "затемнены" в примере кода ниже.

Sub ScratchMacro()
    Dim r As Range
    Dim tbl As word.Table
    Dim rIndex As Long, cIndex As Long, r2Index as Long
    Dim cel As word.Cell, cel2 as Word.Cell
    Dim Red As Long, Purple As Long, Black As Long, _
         Pink As Long, Blue As Long, Green As Long, Yellow As Long

    Red = 255
    Purple = 16711875
    Black = 0
    Pink = 11796735
    Blue = 16711680
    Green = 1954333
    Yellow = 60671
    Set r = ActiveDocument.content
    With r.Find
        Do While .Execute(findText:="The Text You are Searching For", MatchWholeWord:=True, Forward:=True)
          If r.Information(wdWithInTable) Then
            Set tbl = r.Tables(1)
            rIndex = r.Cells(1).RowIndex
            r2Index = r.Cells(1).RowIndex + 1
            cIndex = r.Cells(1).ColumnIndex
            Set cel = tbl.Cell(rIndex, cIndex)
            Set cel2 = tbl.Cell(r2Index, cIndex)
            cel.Range.Shading.BackgroundPatternColor = Blue
            cel2.Range.Shading.BackgroundPatternColor = Blue
            cel.Range.Font.ColorIndex = wdGreen
          End If
        Loop
    End With
End Sub