Word Макросы: Удалить лишние абзацы в сносках

[Svetik]

Здравствуйте!
Скажите пожалуйста, как удалить автоматически лишние абзацы в сносках. Вручную очень долго получается.

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

Эти две процедуры поместите в один модуль. Запускать нужно только процедуру "Макрос", вторая процедура будет запускаться процедурой "Макрос".

Макрос

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

Private Sub DelEmptyPars(lngStoryType As WdStoryType)
   
    Dim rng As Range, fnd As Find, rng2 As Range
   
   
    '1. Создание невидимого курсора, который будет передвигаться в найденное место.
    Set rng = ActiveDocument.StoryRanges(lngStoryType)
   
    '2. Установка невидимого курсора в начало области сносок.
    rng.SetRange Start:=0, End:=0
   
    '3. Создание и настройка объекта, который умеет искать.
    Set fnd = rng.Find
    fnd.text = "(^0013{2;})"
    fnd.Wrap = wdFindStop
    fnd.MatchWildcards = True
   
    Do
   
        '4. Поиск и проверка, было ли найдено.
        If fnd.Execute = False Then
            Exit Do
        End If
       
        '5. Vba-именование найденного фрагмента.
        Set rng2 = rng.Duplicate
       
        '6. Превращение невидимого курсора в точку вставки.
        rng.Collapse Direction:=wdCollapseEnd
       
        '7. Смещение конца найденного фрагмента влево на один символ, чтобы убрать из найденного
            ' фрагмента последний знак абзаца. Иначе не удаляется. В области сносок нельзя удалить
            ' последний знак абзаца в абзаце, потому что нельзя соединить два абзаца в один,
            ' как в обычном тексте.
        rng2.MoveEnd Unit:=wdCharacter, Count:=-1
       
        '8. Удаление найденного фрагмента.
        rng2.Delete
       
    Loop
   
End Sub

[свернуть]

[Svetik]

Не ожидала, что так сложно. Огромное Вам спасибо!

[Anton]

Спасибо.