How to use VBA to to insert header images with different odd and even pages?

36 views Asked by At

My company is rebranding and I have to replace the current header and footer images with the new ones on all of our documents. I can only get the images to show on all pages when the page setups are all the same. When the documents have different odd and even pages, the image only shows on the odd page headers.

Option Explicit
Sub ReplaceBanner()
    Dim Shp, footerRng as Range, oSec as Section
    Const Banner = "D:\Users\Name\Downloads\Rebranding\Header.png" 
    For Each oSec In ActiveDocument.Sections
        Set headerRng = oSec.Headers(wdHeaderFooterPrimary).Range
        oSec.PageSetup.OddAndEvenPagesHeaderFooter = False
        For Each Shp In headerRng.InlineShapes
            Shp.Delete
        Next
        For Each Shp In headerRng.ShapeRange
            Shp.Delete
        Next
        Set Shp = ActiveDocument.Shapes.AddPicture(FileName:=Banner, LinkToFile:=False, _
            SaveWithDocument:=True, Anchor:=headerRng)
        With Shp
            .Left = wdShapeCenter
            .Height = InchesToPoints(0.76)
            .Width = InchesToPoints(8.1)
            .WrapFormat.Type = wdWrapInline
        End With
    Next

1

There are 1 answers

0
taller On

WdHeaderFooterIndex constant has three options:

  • wdHeaderFooterEvenPages
  • wdHeaderFooterFirstPage
  • wdHeaderFooterPrimary

Microsoft documentation:

HeadersFooters object (Word)

Sub ReplaceBanner()
    Dim Shp, footerRng As Range, oSec As section, vFooter
    Const Banner = "D:\Users\Name\Downloads\Rebranding\Header.png"
    For Each oSec In ActiveDocument.Sections
        For Each vFooter In Array(wdHeaderFooterPrimary, wdHeaderFooterEvenPages)
            Set headerRng = oSec.Headers(vFooter).Range
            For Each Shp In headerRng.InlineShapes
                Shp.Delete
            Next
            For Each Shp In headerRng.ShapeRange
                Shp.Delete
            Next
            Set Shp = ActiveDocument.Shapes.AddPicture(FileName:=Banner, LinkToFile:=False, _
                SaveWithDocument:=True, Anchor:=headerRng)
            With Shp
                .Left = wdShapeCenter
                .Height = InchesToPoints(0.76)
                .Width = InchesToPoints(8.1)
                .WrapFormat.Type = wdWrapInline
            End With
        Next
    Next
End Sub