Microsoft Office Forums - View Single Post - Help with VBA to set header on documents with multiple sections

Italophile · 03-21-2022, 07:20 AM

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.

Code:

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