Microsoft Office Forums - View Single Post - [Solved] Inserting new footer into existing documents

gmayor · 05-04-2016, 03:52 AM

The following will remove the Primary Header content and add the footer to the Primary Footer. The first page header and footer are unaffected.

Note the macro addresses only the first section of the document. Letters don't usually have multiple sections, but if yours do the additional sections need to be addressed.

Code:

Option Explicit

Sub ChangeHeaderFooter()
Dim oHeader As HeaderFooter
Dim oFooter As HeaderFooter
Dim strName As String
Dim orng As Range
    strName = InputBox("Enter addressee's name")
    ActiveDocument.PageSetup.DifferentFirstPageHeaderFooter = True
    Set oHeader = ActiveDocument.Sections(1).Headers(wdHeaderFooterPrimary)
    oHeader.Range.Text = ""
    Set oFooter = ActiveDocument.Sections(1).Footers(wdHeaderFooterPrimary)
    Set orng = oFooter.Range
    orng.ParagraphFormat.TabStops.ClearAll
    orng.ParagraphFormat.TabStops.Add _
            Position:=CentimetersToPoints(16.5), _
            Alignment:=wdAlignTabRight, _
            Leader:=wdTabLeaderSpaces
    orng.Text = strName & " | " & Format(Date, "d MMMM yyyy") & vbTab & "Page "
    orng.Collapse 0
    orng.Fields.Add Range:=orng, Type:=wdFieldPage, PreserveFormatting:=False
lbl_Exit:
    Exit Sub
End Sub