asked on

Using VBA to change Word page footer image in both first page and primary footer?

I'm using Microsoft Word VBA to change the footer image in a business letter, depending on the office address chosen in a dialog box. The letter has a different header for first page vs. remaining pages, so I need to update both the first page footer and the primary footer.

I'm having no trouble with the first page footer, but when I go to successive pages, there is no footer image visible. It does not give me an error so I wonder if it's there but just not visible? BIG HINT (I just discovered while writing this): If I reverse the order of my code and modify the first page footer first, followed by the primary footer, now I can see the image in the primary footer, but it's missing in the first page footer. So I must be doing something wrong when switching between them? I need to update both.

Appreciate any help!

Private Sub OKButton_Click() 

Dim footerpngshp As Shape
Dim ftr As HeaderFooter

If Me.ComboBox1.Value = "" Then Exit Sub

footer2insert = contentlibraryfolder & "\Footers\Footer" & Me.ComboBox1.List(Me.ComboBox1.ListIndex, 1) & ".PNG"

Set ftr = ActiveDocument.Sections(1).Footers(wdHeaderFooterPrimary)

If ftr.Shapes.count > 0 Then
    For x = 1 To ftr.Shapes.count
        ftr.Shapes(x).Delete
    Next x
End If

Set footerpngshp = ftr.Shapes.AddPicture(FileName:=footer2insert, LinkToFile:=False, SaveWithDocument:=True)

With footerpngshp
    .WrapFormat.Type = wdWrapBehind
    .LockAnchor = True
    .LockAspectRatio = True
    .RelativeHorizontalPosition = wdRelativeHorizontalPositionPage
    .RelativeVerticalPosition = wdRelativeVerticalPositionPage
    .Left = 27
    .Top = 713
    .Height = 80
End With

Set ftr = ActiveDocument.Sections(1).Footers(wdHeaderFooterFirstPage)

If ftr.Shapes.count > 0 Then
    For x = 1 To ftr.Shapes.count
        ftr.Shapes(x).Delete
    Next x
End If

Set footerpngshp = ftr.Shapes.AddPicture(FileName:=footer2insert, LinkToFile:=False, SaveWithDocument:=True)

With footerpngshp
    .WrapFormat.Type = wdWrapBehind
    .LockAnchor = True
    .LockAspectRatio = True
    .RelativeHorizontalPosition = wdRelativeHorizontalPositionPage
    .RelativeVerticalPosition = wdRelativeVerticalPositionPage
    .Left = 27
    .Top = 713
    .Height = 80
End With

Unload Me

End Sub

Open in new window

ASKER CERTIFIED SOLUTION

GrahamSkan

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

Bryce Bassett

ASKER

Problem solved. Brilliant! Who knew? (Except you, of course)

Just one follow-up question, please: If I run this macro when only the first page of the letter exists, I notice when I later create my second page that the "footer" image is actually sitting up in the header of that second (primary) page.

Do you know why this might be happening?

Thanks, Graham.

GrahamSkan

Sorry for the delay.

This area is undoubtedly buggy.

I tried re-running your code after adding the extra text. It fails because the shapes count is > 0 but item (1) is missing. This code works:

Dim bExists As Boolean
Do
    bExists = False
    For Each sh In ftr.Shapes
        bExists = True
        sh.Delete
    Next sh
Loop While bExists

Open in new window

However, it may be better to add some spurious text before inserting the shapes and to delete it afterwards

Bryce Bassett

ASKER

Thanks, Graham. I realized I needed to reverse my loop to avoid referring to shapes that were already deleted. Your code does that too. But my primary footer image was still showing up in the header of the second page, unless that page exists at the time I put the image there. So I added a page count check, then if only 1 page, I create a temporary dummy second page, add my footer image, then remove the second page. Seems to work. Anyway, thanks for your help!

footer2insert = contentlibraryfolder & "\Footers\Footer" & Me.ComboBox1.List(Me.ComboBox1.ListIndex, 1) & ".PNG"

Set ftr = ActiveDocument.Sections(1).Footers(wdHeaderFooterFirstPage)

If ftr.Shapes.count > 0 Then
    For x = ftr.Shapes.count To 1 Step -1
        ftr.Shapes(x).Delete
    Next x
End If

Set footerpngshp = ftr.Shapes.AddPicture(FileName:=footer2insert, LinkToFile:=False, SaveWithDocument:=True)

With footerpngshp
    .WrapFormat.Type = wdWrapBehind
    .LockAnchor = True
    .LockAspectRatio = True
    .RelativeHorizontalPosition = wdRelativeHorizontalPositionPage
    .RelativeVerticalPosition = wdRelativeVerticalPositionPage
    .Left = 27
    .Top = 713
    .Height = 80
End With

If ActiveDocument.Range.Information(wdNumberOfPagesInDocument) = 1 Then
    onepageonly = True
    Set returnbm = ActiveDocument.Bookmarks.Add("returnhere")
    Selection.EndKey Unit:=wdStory
    Selection.InsertBreak Type:=wdPageBreak
End If

Set ftr = ActiveDocument.Sections(1).Footers(wdHeaderFooterPrimary)

Set footerpngshp = ftr.Shapes.AddPicture(FileName:=footer2insert, LinkToFile:=False, SaveWithDocument:=True)

With footerpngshp
    .WrapFormat.Type = wdWrapBehind
    .LockAnchor = True
    .LockAspectRatio = True
    .RelativeHorizontalPosition = wdRelativeHorizontalPositionPage
    .RelativeVerticalPosition = wdRelativeVerticalPositionPage
    .Left = 27
    .Top = 713
    .Height = 80
End With

If onepageonly = True Then
    Selection.TypeBackspace
    Selection.TypeBackspace
    ActiveDocument.Bookmarks("returnhere").Range.Select
    ActiveDocument.Bookmarks("returnhere").Delete
End If

Open in new window

Bryce Bassett

ASKER

Thanks!