Help with VBA to set header on documents with multiple sections

[xdavemarshallx]

Good morning everyone - new member here hoping someone may be able to point me in the right direction.

I am attempting to build macros into a normal.dotm template to allow for electronic letterheads to be inserted into any word file for latter conversion to PDF and electronic distribution. The letterhead comprises of a primary letter head for the first page, and secondary continuation pages (which in reality are just a colour stripe on subsequent pages).

I have managed to get a solution which works on single section documents, which sets the first page header as being different to the others, before inserting an image into the first page header and a second image into the primary page header, this results in the full letterhead within the header on the first page and the colour stripe on all subsequent pages (providing those pages exist when the macro is executed).

However, I have various other word documents which make use of multiple sections, often a different section starting on page 2 to allow for a smaller header (where a larger header is not needed to avoid address details etc on the first page letterhead), but there may be others with three of four sections in total.

As it stands, my VBA code below is only applying to the first section in circumstances where the document has multiple sections and for the life of me I cannot fathom, without generating errors, what is needed to have the code apply to all sections (albeit any section beyond section 1 would only need the primary header applied, as the first page of the document would only ever be in the first section).

I am a relative novice when it comes to VBA and most of the code below has been taken and amended from various other public sources plus some trial and error, rather than have a real understanding of all of it.

Any help would be greatly appreciated.

Many thanks

Dave





Sub StdLetterhead()

Dim oSec As Section
Dim oHead As HeaderFooter

For Each oSec In ActiveDocument.Sections
For Each oHead In oSec.Headers


If oHead.Exists Then oHead.Range.Delete
Next oHead

Next oSec

ActiveDocument.PageSetup.DifferentFirstPageHeaderF ooter = True

ActiveWindow.ActivePane.View.SeekView = wdSeekFirstPageHeader

Dim ohShape As Shape, ohRange As Range
Dim hPfad As String
hPfad = "\\Server\StdLetterhead.jpg"

Set ohRange = Selection.Range
Set ohShape = ActiveDocument.Shapes.AddPicture(FileName:=hPfad, LinkToFile:=False, SaveWithDocument:=True, Anchor:=ohRange)
ohShape.Height = CentimetersToPoints(29.79)
ohShape.Width = CentimetersToPoints(21.08)
ohShape.Left = CentimetersToPoints(-1.59)
ohShape.Top = CentimetersToPoints(-1.35)
ohShape.ZOrder msoSendBehindText

On Error GoTo ErrorHandler
ActiveWindow.ActivePane.View.SeekView = wdSeekPrimaryHeader

Dim ohcShape As Shape, ohcRange As Range
Dim hcPfad As String
hcPfad = "\\Server\Continuation.jpg"
Set ohcRange = Selection.Range
Set ohcShape = ActiveDocument.Shapes.AddPicture(FileName:=hcPfad, LinkToFile:=False, SaveWithDocument:=True, Anchor:=ohcRange)

ohcShape.Height = CentimetersToPoints(29.79)
ohcShape.Width = CentimetersToPoints(21.08)
ohcShape.Left = CentimetersToPoints(-1.59)
ohcShape.Top = CentimetersToPoints(-1.35)
ohcShape.ZOrder msoSendBehindText

ErrorHandler:

ActiveDocument.ActiveWindow.View.Type = wdPrintView
ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument

End Sub

[Italophile]

You don't need to select the headers, you can work with them directly as you do in the loop where you delete the existing headers.

Just as you looped through the sections to delete the existing headers you need to do the same thing to add the replacements.

Sub StdLetterhead()

    Dim oSec As Section
    Dim oHead As HeaderFooter

    For Each oSec In ActiveDocument.Sections
        For Each oHead In oSec.Headers
            If oHead.Exists Then oHead.Range.Delete
        Next oHead

    Next oSec

    ActiveDocument.PageSetup.DifferentFirstPageHeaderFooter = True

    Dim ohShape As Shape, ohRange As Range
    Dim hPfad As String
    hPfad = "\\Server\StdLetterhead.jpg"

    Set ohRange = ActiveDocument.Sections(1).Headers(wdHeaderFooterFirstPage).Range
    Set ohShape = ActiveDocument.Shapes.AddPicture(FileName:=hPfad, LinkToFile:=False, SaveWithDocument:=True, Anchor:=ohRange)
    With ohShape
        .Height = CentimetersToPoints(29.79)
        .Width = CentimetersToPoints(21.08)
        .Left = CentimetersToPoints(-1.59)
        .Top = CentimetersToPoints(-1.35)
        .ZOrder msoSendBehindText
    End With

    On Error GoTo ErrorHandler

    Dim ohcShape As Shape, ohcRange As Range
    Dim hcPfad As String
    hcPfad = "\\Server\Continuation.jpg"
    For Each oSec In ActiveDocument.Sections
    
        Set ohcRange = oSec.Headers(wdHeaderFooterPrimary).Range
        Set ohcShape = ActiveDocument.Shapes.AddPicture(FileName:=hcPfad, LinkToFile:=False, SaveWithDocument:=True, Anchor:=ohcRange)
        With ohcShape
            .Height = CentimetersToPoints(29.79)
            .Width = CentimetersToPoints(21.08)
            .Left = CentimetersToPoints(-1.59)
            .Top = CentimetersToPoints(-1.35)
            .ZOrder msoSendBehindText
        End With
    Next oSec

ErrorHandler:


End Sub

[xdavemarshallx]

Originally Posted by Italophile

You don't need to select the headers, you can work with them directly as you do in the loop where you delete the existing headers.

Just as you looped through the sections to delete the existing headers you need to do the same thing to add the replacements.

Italophile, thank you and sorry for the delay in responding. After a couple of amendments to add in a routine to set only the first section as having a different first page, I now appear to have this working as intended. I am very grateful.