Форум по VBA и MS Office

Sub Макрос()

    '1. Отключение монитора.
    Application.ScreenUpdating = False

    '2. Удаление в страничных сносках.
    If ActiveDocument.Footnotes.Count <> 0 Then
        DelEmptyPars ActiveDocument.StoryRanges(wdFootnotesStory)
    End If
   
    '3. Удаление в концевых сносках.
    If ActiveDocument.Endnotes.Count <> 0 Then
        DelEmptyPars ActiveDocument.StoryRanges(wdEndnotesStory)
    End If
   
    '4. Вкл. монитора.
    Application.ScreenUpdating = True
   
    '5. Сообщение.
    MsgBox "Готово.", vbInformation

End Sub

Private Sub DelEmptyPars(rng As Range)
   
    ' Удаление пустых абзацев в сносках.
   
    Dim i As Long
   
    For i = rng.Paragraphs.Count To 1 Step -1
        If rng.Paragraphs(i).Range.Characters.Count = 1 Then
            rng.Paragraphs(i).Range.Delete
        End If
    Next i

End Sub