Word VBA: Установить пустые абзацы перед разрывами с помощью макроса.

[Alexey Dymov]

Помогите с макросом, который устанавливает 3 пустых абзаца перед разрывами страницы или раздела в выбранном фрагменте текста. Причем несколько пустых абзацев могут перед разрывами уже быть.

[вложение удалено администратором]

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

Макрос

Sub Макрос()
   
    ' Макрос работает со всеми видами разрывов: страниц, разделов.
   
    '1. Отключение монитора, чтобы не мерцало. Возможно это ещё ускорит макрос.
    Application.ScreenUpdating = False
   
    '2. Удаление пустых абзацев перед всеми разрывами.
    With Selection.Range.find
        .Text = "(^13)(^13@)(^m)"
        .Replacement.Text = "\1\3"
        .Wrap = wdFindStop
        .MatchWildcards = True
        .Execute Replace:=wdReplaceAll
    End With

    '3. Вставка трёх пустых абзацев перед всеми разрывами.
    With Selection.Range.find
        .Text = "^m"
        .Replacement.Text = "^p^p^p^&"
        .Wrap = wdFindStop
        .MatchWildcards = True
        .Execute Replace:=wdReplaceAll
    End With
   
    '4. Включение монитора.
    Application.ScreenUpdating = True
   
    '5. Сообщение.
    MsgBox "Готово.", vbInformation

End Sub

[свернуть]