Двойная нумерация страниц в документе

Источник: wordexpert

Возникла необходимость вести в документе две нумерации страниц - сквозную (внизу страницы) и внутреннюю, по разделам, то есть часть номеров страниц в верхнем и нижнем колонтитуле не совпадает - можно это автоматизировать?

Я написал макрос. К сожалению, в редакторе Word 2007 макрос хоть и работает, но сквозная нумерация страниц не поддерживается (в нижнем колонтитуле). Если кто-нибудь сможет доработать этот макрос для Word 2007, я буду благодарен (не один я, наверное).

Sub twinNumberingPages()
'Двойная нумерация страниц в документе, состоящим из разделов:
'  верхний колонтитул - номер страницы в текущем разделе
'  нижний колонтитул - сквозной номер страницы всего документа
'Создан на основе статьи Microsoft http://support.microsoft.com/kb/291283
'Макрос был поправлен Steven Graig Miller 09.06.2008 г.
Dim oRange As Range
Dim hfRange As Range
Dim nSections As Long
Dim nIndex As Long
'
' Шаг 1: Добавляем поля в начало первой страницы первого раздела
'
Set oRange = ActiveDocument.Range(0, 0) 'определяем начало документа
oRange.Select
oRange.Fields.Add Range:=Selection.Range, Type:=wdFieldSequence, Text:="variable1 \h \r", PreserveFormatting:=False
ActiveDocument.ActiveWindow.View.ShowFieldCodes = True
Selection.Move wdCharacter, -1
oRange.Fields.Add Range:=Selection.Range, Type:=wdFieldSectionPages, PreserveFormatting:=False
Selection.Move wdCharacter, 1
oRange.Fields.Add Range:=Selection.Range, Type:=wdFieldSequence, Text:="variable2 \h \r0", PreserveFormatting:=False
nSections = ActiveDocument.Sections.Count
'
' Шаг 2: Добавляем два поля в начало каждого раздела кроме 1-го раздела
'
If nSections > 1 Then
    For nIndex = 2 To nSections
        Set oRange = ActiveDocument.Sections(nIndex).Range
        oRange.Collapse wdCollapseStart
        oRange.Select
        oRange.Fields.Add Range:=Selection.Range, Type:=wdFieldSequence, Text:="variable2 \h \r", PreserveFormatting:=False
        Selection.Move wdCharacter, -1
        oRange.Fields.Add Range:=Selection.Range, Type:=wdFieldExpression, PreserveFormatting:=False
        Selection.Move wdCharacter, 3
        oRange.Fields.Add Range:=Selection.Range, Type:=wdFieldSequence, Text:="variable1 \c", PreserveFormatting:=False
        Selection.Move wdCharacter, 3
        oRange.Fields.Add Range:=Selection.Range, Type:=wdFieldSequence, Text:="variable1 \h \r", PreserveFormatting:=False
        Selection.Move wdCharacter, -1
        oRange.Fields.Add Range:=Selection.Range, Type:=wdFieldExpression, Text:="+", PreserveFormatting:=False
        Selection.Move wdCharacter, 3
        oRange.Fields.Add Range:=Selection.Range, Type:=wdFieldSectionPages, PreserveFormatting:=False
        Selection.Move wdCharacter, 3
        oRange.Fields.Add Range:=Selection.Range, Type:=wdFieldSequence, Text:="variable2 \c", PreserveFormatting:=False
    Next nIndex
End If
'
' Шаг 3: Добавляем верхний и нижний колонтитулы
'
ActiveDocument.ActiveWindow.View.ShowFieldCodes = False
Set hfRange = oRange.Sections(1).Headers(wdHeaderFooterPrimary).Range
With hfRange
    .Delete
    .Text = "Страница "
    .MoveEnd unit:=wdCharacter, Count:=1
    .Collapse wdCollapseEnd
    oRange.Fields.Add Range:=hfRange, Type:=wdFieldPage
    .MoveEnd unit:=wdCharacter, Count:=1
    .Collapse wdCollapseEnd
    .Text = " из "
    .MoveEnd unit:=wdCharacter, Count:=1
    .Collapse wdCollapseEnd
    oRange.Fields.Add Range:=hfRange, Type:=wdFieldSectionPages
End With
Set hfRange = oRange.Sections(1).Footers(wdHeaderFooterPrimary).Range
ActiveDocument.ActiveWindow.View.ShowFieldCodes = True
hfRange.Collapse wdCollapseStart
hfRange.Select
hfRange.Fields.Add Range:=Selection.Range, Type:=wdFieldExpression, Text:="+", PreserveFormatting:=False
Selection.Move wdCharacter, 3
oRange.Fields.Add Range:=Selection.Range, Type:=wdFieldSequence, Text:="variable2 \c", PreserveFormatting:=False
Selection.Move wdCharacter, 3
oRange.Fields.Add Range:=Selection.Range, Type:=wdFieldPage, PreserveFormatting:=False
ActiveDocument.ActiveWindow.View.ShowFieldCodes = False
'
' Шаг 4: Устанавливаем формат номеров (нумерация начинается с 1 в каждом разделе)
'
For nIndex = 1 To nSections
    With ActiveDocument.Sections(nIndex).Headers(wdHeaderFooterPrimary)
        .PageNumbers.NumberStyle = wdPageNumberStyleArabic
        .PageNumbers.HeadingLevelForChapter = 0
        .PageNumbers.IncludeChapterNumber = False
        .PageNumbers.ChapterPageSeparator = wdSeparatorHyphen
        .PageNumbers.RestartNumberingAtSection = True
        .PageNumbers.StartingNumber = 1
    End With
Next nIndex
ActiveDocument.Range(0, 0).Select
ActiveWindow.View.Type = wdPrintView    'переключаемся в режим Разметка страницы
ActiveWindow.View.Zoom.PageFit = wdPageFitBestFit
End Sub

Ссылки по теме