Microsoft Office Forums - View Single Post

gmayor · 05-05-2015, 07:11 AM

You don't really need a macro to do this, but the following will do it. There are however provisos and the main one revolves around how the footers are configured. There are potentially lots of footer ranges in a document - three to each section. This macro addresses only the primary footer.

Code:

Option Explicit

Sub AddPageNumbers()
Dim oRng As Range
Dim oFooter As HeaderFooter
    Set oRng = ActiveDocument.Bookmarks("\page").Range
    oRng.Collapse 1
    oRng.InsertBreak wdSectionBreakContinuous
    Set oFooter = oRng.Sections(1).Footers(wdHeaderFooterPrimary)
    oFooter.LinkToPrevious = False
    If Len(oFooter.Range.Text) > 1 Then
        oFooter.Range.InsertParagraphAfter
    End If
    With oFooter.PageNumbers
        .NumberStyle = wdPageNumberStyleArabic
        .HeadingLevelForChapter = 0
        .IncludeChapterNumber = False
        .ChapterPageSeparator = wdSeparatorHyphen
        .RestartNumberingAtSection = True
        .StartingNumber = 1
    End With
    Set oRng = oFooter.Range
    With oRng
        .Collapse 0
        .Text = "Page "
        .Collapse 0
        .Fields.Add oRng, wdFieldPage, , False
        .ParagraphFormat.Alignment = wdAlignParagraphLeft
    End With
lbl_Exit:
    Set oFooter = Nothing
    Set oRng = Nothing
    Exit Sub
End Sub