View Single Post
 
Old 03-21-2022, 03:54 AM
xdavemarshallx xdavemarshallx is offline Windows 10 Office 2021
Novice
 
Join Date: Mar 2022
Posts: 2
xdavemarshallx is on a distinguished road
Default 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
Reply With Quote