Word VBA Макросы: Очистить колонтитулы

[Anton]

Добрый день!
А можно ли макросом очистить все колонтитулы в документе (удалить в них все, что есть, все объекты и лишние абзацы) и привести размеры все к одному виду: от верхнего края до верхнего колонтитула и от нижнего края до верхнего колонтитула чтобы было 1,25 см.
Пример моего текста приложил. Собирал из разных источников, расстояние от края в разных разделах разное. Средствами Word не придумал, как все сразу исправить.

[вложение удалено администратором]

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

Макрос

Sub макрос()

    Dim sec As Section, kolontitle As HeaderFooter
   
   
    '1. Отключение монитора (может это ускорит макрос и не будет мерцать).
    Application.ScreenUpdating = False
   
    '2. Цикл по всем разделам.
    For Each sec In ActiveDocument.Sections
   
        '1) Цикл по трём видам верхнего колонтитула.
        For Each kolontitle In sec.Headers
            ' Очистка колонтитула.
            DelElements kolontitle.Range
            ' Сброс оформления.
            kolontitle.Range.style = ActiveDocument.Styles(wdStyleHeader).NameLocal
        Next kolontitle
       
        '2) Цикл по трём видам нижнего колонтитула.
        For Each kolontitle In sec.Footers
            ' Очистка колонтитула.
            DelElements kolontitle.Range
            ' Сброс оформления.
            kolontitle.Range.style = ActiveDocument.Styles(wdStyleFooter).NameLocal
        Next kolontitle
       
        '3) Параметры страницы.
        sec.PageSetup.HeaderDistance = CentimetersToPoints(1.25)
        sec.PageSetup.FooterDistance = CentimetersToPoints(1.25)
   
    Next sec
   
    '3. Включение монитора.
    Application.ScreenUpdating = True
   
    '4. Сообщение.
    MsgBox "Готово", vbInformation
   
End Sub

Private Sub DelElements(rng As Range)

    ' Очистка колонтитула.
   
    Dim i As Long
   
   
    '1. Удаление текста.
    rng.text = ""
   
    '2. Удаление рисунков-инлайншейпов.
    For i = rng.InlineShapes.Count To 1 Step -1
        rng.InlineShapes(i).Delete
    Next i
   
    '3. Удаление рисунков-шейпов.
    For i = rng.ShapeRange.Count To 1 Step -1
        rng.ShapeRange(i).Delete
    Next i
   
    '4. Удаление рамок (в новых версиях ворда не знаю, как они вставляются).
    For i = rng.Frames.Count To 1 Step -1
        rng.Frames(i).Delete
    Next
   
End Sub

[свернуть]

[Anton]

Сработало! Большое спасибо!