Help with VBA to set header on documents with multiple sections
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
|