Форум по VBA и MS Office

Sub Макрос()
   
    '1. Обработка концевых сносок.
    If ActiveDocument.Endnotes.Count <> 0 Then
        Call Procedure1(wdPaneEndnotes)
    End If
   
    '2. Обработка страничных сносок.
    If ActiveDocument.Footnotes.Count <> 0 Then
        Call Procedure1(wdPaneFootnotes)
    End If
   
End Sub

Private Sub Procedure1(lngPaneType As WdSpecialPane)
   
    Dim lng_start As Long, var
   
   
    '1. Отображение снизу области со всеми сносками.
        ' При этом курсор переходит в эту область.
    '1) Запоминаем, сколько отображается областей, чтобы понять, открылась область со сносками
        ' или закрылась, т.к. команда ниже делает и то и другое в зависимости от ситуации.
    var = ActiveWindow.Panes.Count
    '2) Отображение области со сносками.
    ActiveWindow.View.SplitSpecial = lngPaneType
    '3) Проверяем, закрылась область или открылась. Если закрылась, то ещё раз открываем.
    If ActiveWindow.Panes.Count < var Then
        ' Отображение области со сносками.
        ActiveWindow.View.SplitSpecial = lngPaneType
    End If
   
    '2. Переход в начало области сносок. В некоторых случаях курсор сам не оказывается
        ' в начале, например, если сноски скопировать и вставить в новый пустой файл.
    Selection.HomeKey Unit:=wdStory
   
    ' Цикл по строкам в области сносок.
    Do
       
        '3. Перемещение курсора в конец строки.
        Selection.EndKey Unit:=wdLine
       
        '4. Перемещение курсора влево, если есть пробелы.
        Selection.MoveWhile Cset:=" ", Count:=wdBackward
       
        '5. Перемещение курсора влево, если есть тире. Это нужно потому,
            ' что после вставки разрыва строки, курсор перейдёт на следующую строку.
            ' А нужно, чтобы курсор остался на этой же строке.
        Selection.MoveWhile Cset:=Chr(150), Count:=wdBackward
       
        ' Проверка, если ли справа тире.
        If Selection.Text = Chr(150) Then
            ' Проверка, есть ли перед тире пробел. Переносить нужно то тире, перед которым есть пробел.
            If Selection.Characters(1).Previous.Text = " " Then
                '6. Вставка перед тире разрыва строки.
                Selection.Text = Chr(11)
            End If
        End If
       
        '7. Переход на следующую строку и проверка, произошёл ли переход на следующую строку.
    Loop While Selection.MoveDown(Unit:=wdLine, Count:=1) <> 0

    '8. Закрытие области со сносками.
    ActiveWindow.View.SplitSpecial = lngPaneType
   
End Sub