Inserting new footer into existing documents

mgirving · #1 05-04-2016, 02:25 AM

Our company has changed the look of its documents and one of the changes is that documents now have a second page footer instead of a second page header and the footer content is also different.

I recorded the macro below to enable users to update any documents they are already working with on the 'change over day' to be compliant with the new look (so that users don't have to start from scratch with their work in one of the new look templates but can continue working on existing documents).

When the macro is run it produces variable results. Most often, instead of the new footer appearing in the footer, it appears in the body of the documents. I have read forum posts that explain that a recorded macro is unreliable and it is best done through VBA.

I would be grateful for any assistance in how I can convert this into a VBA code.

Ideally, I would like to set it up so that it can be run on a document regardless of how many pages it currently is. If it is currently only a one page letter, the macro would still set up the new footer in case the user creates a second page of the letter after typing some more content.

Thank you for any assistance.

' New Footer Macro
'
'
Selection.EndKey Unit:=wdStory
Selection.InsertBreak Type:=wdPageBreak
Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, Text:= _
"FILLIN ""Insert addressee's name"" ", PreserveFormatting:=True
Selection.TypeText Text:=" | "
Selection.InsertDateTime DateTimeFormat:="d MMMM yyyy", InsertAsField:= _
False, DateLanguage:=wdEnglishUS, CalendarType:=wdCalendarWestern, _

InsertAsFullWidth:=False
Selection.TypeText Text:=vbTab
Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, Text:= _
"PAGE \* Arabic ", PreserveFormatting:=True
Selection.MoveLeft Unit:=wdCharacter, Count:=1
Selection.TypeText Text:="Page "
Selection.ParagraphFormat.TabStops(CentimetersToPo ints(7.62)).Position = _
CentimetersToPoints(7.62)
Selection.ParagraphFormat.TabStops.ClearAll
ActiveDocument.DefaultTabStop = CentimetersToPoints(1.2)
Selection.ParagraphFormat.TabStops.Add Position:=CentimetersToPoints(16.5) _
, Alignment:=wdAlignTabRight, Leader:=wdTabLeaderSpaces
Selection.HomeKey Unit:=wdLine
Selection.TypeParagraph
ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
Selection.TypeBackspace
End Sub

gmayor · #2 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

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
edit date in footer of existing slides	eNGiNe	PowerPoint	6	05-27-2015 05:39 AM
Inserting Table of Figures Insists on Overwriting Existing	sleake	Word	8	09-15-2013 02:42 PM
How to insert full documents into existing word document	Laraak	Word	1	03-07-2013 11:59 PM
Inserting section between existing sections	GoneBirding	Word	0	10-18-2012 03:01 PM
Assigning templates to existing documents. Update Styles Enmasse.	bannerdog	Word	1	02-28-2012 03:53 PM