Word Макрос: Очистить формат по условию поиска

[Anton]

Добрый день!
Помогите пожалуйста решить такую задачу: если найдено в абзаце слово "Ответ", то нужно очистить форматирование у этого абзаца (в записи макрорекордером это Selection.ClearFormatting).

[Администратор]

А какие абзацы просматривать? Все, какие есть в основной части файла, или в выделенном фрагменте, или в абзаце, где находится курсор?

[Anton]

А можно так: если есть выделенный фрагмент, то в нем, а если нет - то во всем документе?

[Администратор]

Регистр (большие/маленькие буквы) нужно учитывать?
Если в абзаце есть текст "Ответный", то это тоже относится к слову "Ответ"?

[Anton]

Да, регистр и отдельное слово важны! "Ответный" не нужно учитывать, как и "ответ", только "Ответ".

[Администратор]

Макрос

Sub Макрос()
   
    '1. Отключение монитора.
    Application.ScreenUpdating = False
   
    '2. Если текст не выделен, то есть курсор мигает.
    If Selection.Type = wdSelectionIP Then
        InWhole
    '3. Во всех остальных случаях.
    Else
        InSelection
    End If
   
    '4. Вкл. монитора.
    Application.ScreenUpdating = True
   
    '5. Сообщение.
    MsgBox "Готово.", vbInformation

End Sub

Private Sub InWhole()
   
    ' Поиск во всём файле (в основной части, а не в сносках и т.п.).
   
    Dim find_rng As Range, find As find
   
   
    '1. Создание объектов для поиска.
    Set find_rng = ActiveDocument.Range(0, 0)
    Set find = find_rng.find
   
    '2. Настройка поиска.
    find.text = "<Ответ>"
    find.MatchWildcards = True
    find.Wrap = wdFindStop
   
    '3. Поиск и замена.
    Do While find.Execute = True
   
        '1) Сброс оформления у всего абзаца, где находится найденное слово.
        find_rng.Paragraphs(1).Range.Select
        Selection.ClearFormatting
       
        '2) Смещение невидимого курсора вправо от найденного абзаца, чтобы поиск
            ' началася после найденного абзаца, а не в найденном абзаце.
        find_rng.SetRange Start:=Selection.End, End:=Selection.End
       
    Loop
   
End Sub

Private Sub InSelection()

    ' Поиск в выделенном фрагменте.
   
    Dim find_rng As Range, find As find, SelEnd As Long
   
   
    '1. Запоминание конца выделения.
    SelEnd = Selection.Range.End
   
    '2. Создание объектов для поиска.
    Set find_rng = Selection.Range.Duplicate
    find_rng.Collapse Direction:=wdCollapseStart
    Set find = find_rng.find
   
    '3. Настройка поиска.
    find.text = "<Ответ>"
    find.MatchWildcards = True
    find.Wrap = wdFindStop
   
    '4. Поиск и замена.
    Do While find.Execute = True
   
        '1) Если найдено за пределами выделенного фрагмента.
        If find_rng.End > SelEnd Then
            Exit Do
        End If
       
        '2) Сброс оформления у всего абзаца, где находится найденное слово.
        find_rng.Paragraphs(1).Range.Select
        Selection.ClearFormatting
       
        '3) Смещение невидимого курсора вправо от найденного абзаца, чтобы поиск
            ' началася после найденного абзаца, а не в найденном абзаце.
        find_rng.SetRange Start:=Selection.End, End:=Selection.End
       
    Loop
   
End Sub

[свернуть]

[Anton]

Признателен Вам! Большое спасибо!