Форум по VBA и MS Office

Sub Макрос1()
   
    Dim rng As Range, fnd As Find
   
   
    '1. Отключение монитора.
    Application.ScreenUpdating = False
   
    '2. Вставка после разрывов страниц разрывов разделов. Сразу нельзя заменить
        ' разрывы страниц на разрывы разделов, т.к. нет спецсимвола для разрыва
        ' раздела с текущей страницы - у всех разрывов разделов один ansi-символ 12.
       
    '1) Создание объектов для поиска.
    Set rng = ActiveDocument.Range(0, 0)
    Set fnd = rng.Find
   
    '2) Настройка поиска.
    fnd.Text = "^m"
    fnd.MatchWildcards = False
    fnd.Wrap = wdFindStop
   
    '3) Вставка разрывов разделов.
    Do While fnd.Execute = True
        ' Вставка перед разрывом страницы знака абзаца, если его нет, т.к.
            ' это кажется правильнее, чем после текста сразу будет разрыв.
        If rng.Characters(1).Previous.Text <> Chr(13) Then
            rng.InsertBefore Text:=Chr(13)
            ' Знак абзаца будет добавлен в "rng", поэтому смещаем левый край вправо,
                ' чтобы разрыв раздела встал после знака абзаца.
            rng.MoveStart Unit:=wdCharacter, Count:=1
        End If
        ' Вставка перед разрывом страницы разрыва раздела. Разрыв вставляется
            ' именно перед разрывом страницы, а не после, как могло бы показаться.
        rng.InsertBreak Type:=wdSectionBreakContinuous
        ' После вставки разрыва раздела "rng" сделает коллапс в начало найденного разрыва страницы,
            ' поэтому нужно сместится вправо на один символ, чтобы выйти за пределы
            ' найденного разрыва страницы и приступить к поиску следующего разрыва страницы.
        rng.Move Unit:=wdCharacter, Count:=1
    Loop
   
    '3. Удаление разрывов страниц.
    '1) Удаление разрывов страниц в файлах формата "doc" (это "Word 2003").
        ' В старой версии для разрыва страницы не создавался отдельный абзац.
    If ActiveDocument.SaveFormat = wdFormatDocument Then
        With ActiveDocument.Range.Find
            .Text = "^m"
            .Replacement.Text = ""
            .Execute Replace:=wdReplaceAll
        End With
    '2) Удаление разрывов страниц в файлах нового формата ("Word 2007+").
        ' В новых версиях разрыв страницы помещается в отдельный абзац. Если просто
            ' удалить разрыв страницы, то останется лишний знак абзаца. Поэтому нужно удалять не
            ' просто разрыв страницы, а разрыв страницы и знак абзаца.
        ' Применять такой поиск: .Text = "^m^p" к doc-формату нельзя, т.к.
            ' если после разрыва страницы есть пустой абзац, то пустой абзац будет удалён.
    Else
        With ActiveDocument.Range.Find
            .Text = "^m^p"
            .Replacement.Text = ""
            .Execute Replace:=wdReplaceAll
        End With
    End If
   
    '4. Включение монитора.
    Application.ScreenUpdating = True
   
    '5. Сообщение.
    MsgBox "Готово.", vbInformation

End Sub