Форум по VBA и MS Office

Sub Макрос()

    Dim find_rng As Range, find As find
    Dim rng As Range
   
   
    '1. Откл. монитора.
    Application.ScreenUpdating = False
   
    '2. Создание объектов, которые будут искать.
    Set find_rng = ActiveDocument.Range(ActiveDocument.Range.End - 1, ActiveDocument.Range.End - 1)
    Set find = find_rng.find
   
    '3. Настройка поиска.
    find.text = "^13{2;}"
    find.MatchWildcards = True
    ' Поиск с конца файла в начало.
    find.Forward = False
    find.Wrap = wdFindStop
   
    '4. Поиск.
    Do While find.Execute = True
   
        '1) Присваиваем имя "rng" найденному фрагменту.
        Set rng = find_rng.Duplicate
       
        '2) Переставляем невидимый курсор в начало найденного, чтобы
            ' потом продолжить поиск от найденного и до начала файла.
        find_rng.Collapse Direction:=wdCollapseStart
       
        '3) Сравниваем стиль первого абзаца в найденном фрагменте и стиль
            ' абзаца, который находится после найденного фрагмента.
        If rng.Paragraphs(1).Style <> rng.Paragraphs.Last.Next.Style Then
            '4) Первый знак абзаца находится в абзаце с текстом, поэтому
                ' нужно изменить фрагмент.
            rng.MoveStart Unit:=wdCharacter, Count:=1
            '5) Удаление пустых абзацев.
            rng.Delete
        End If
       
    Loop
   
    '5. Вкл. монитора.
    Application.ScreenUpdating = True
   
    '6. Сообщение.
    MsgBox "Готово.", vbInformation
   
End Sub

Sub Макрос()

    Dim find_rng As Range, find As find
    Dim rng As Range, style1 As String, style2 As String
   
   
    '1. Откл. монитора.
    Application.ScreenUpdating = False
   
    '2. Здесь укажите имена стилей.
    style1 = "Обычный"
    style2 = "Заголовок 1"
   
    '3. Создание объектов, которые будут искать.
    Set find_rng = ActiveDocument.Range(ActiveDocument.Range.End - 1, ActiveDocument.Range.End - 1)
    Set find = find_rng.find
   
    '4. Настройка поиска.
    find.Text = "^13{2;}"
    find.MatchWildcards = True
    ' Поиск с конца файла в начало.
    find.Forward = False
    find.Wrap = wdFindStop
   
    '5. Поиск.
    Do While find.Execute = True
   
        '1) Присваиваем имя "rng" найденному фрагменту.
        Set rng = find_rng.Duplicate
       
        '2) Переставляем невидимый курсор в начало найденного, чтобы
            ' потом продолжить поиск от найденного и до начала файла.
        find_rng.Collapse Direction:=wdCollapseStart
       
        '3) Смотрим стиль первого абзаца в найденном фрагменте.
        ' Если это нужный стиль.
        If rng.Paragraphs(1).Style = style1 Then
            '4) Смотрим абзац после найденного фрагмента.
            ' Если это нужный стиль.
            If rng.Paragraphs.Last.Next.Style = style2 Then
                '5) Первый знак абзаца находится в абзаце с текстом, поэтому
                    ' нужно изменить фрагмент.
                rng.MoveStart Unit:=wdCharacter, Count:=1
                '6) Удаление пустых абзацев.
                rng.Delete
            End If
        End If
       
    Loop
   
    '6. Вкл. монитора.
    Application.ScreenUpdating = True
   
    '7. Сообщение.
    MsgBox "Готово.", vbInformation
   
End Sub

Sub Макрос()
    With ActiveDocument.Range.find
        .Text = "(^32{1;})(^13)"
        .Replacement.Text = "\2"
        .MatchWildcards = True
        .Execute Replace:=wdReplaceAll
    End With
End Sub