Add, Resize & Relocate Header & Footer with Macros

Sarah123 · #1 11-12-2018, 06:18 PM

Hi,

We have a large volume of templates that need to be formatted for print & electronic distribution. Print needs to be blank so it can be printed on pre-printed letter head. For electronic distribution, I want to add a macro button in to insert our company header and footer. I have the below to bring the pictures through, but I have no idea how to resize and relocate into the correct position. Any ideas would be greatly appreciated!

Sub AddImageToHeader()

Dim SrcePath As String

SrcePath = "S:\DocBase\Document Templates\Macros\New Macros Nov 2018\Letterhead.jpg"

ThisDocument.Sections.Item(1).Headers(wdHeaderFoot erPrimary) _
.Range.InlineShapes.AddPicture (SrcePath)

End Sub

Sub AddImageToFooter()

Dim SrcePath As String

SrcePath = "S:\DocBase\Document Templates\Macros\New Macros Nov 2018\Footer Pg1.jpg"

ThisDocument.Sections.Item(1).Footers(wdHeaderFoot erPrimary) _
.Range.InlineShapes.AddPicture (SrcePath)

End Sub

AntiqueWhale · #2 11-12-2018, 06:37 PM

The AddPicture method will return an InlineShape object, you can set a variable reference the picture you added, and then play with the properties of the lineshape, like height, width, borders...etc

Code:

Dim header_pic as InlineShape
Set footerPic = ThisDocument.Sections(1).Footers(wdHeaderFooterPrimary).Range.InlineShapes.AddPicture(SrcePath)
With footerPic
    .Width = xxxx
    .Height = xxxx
End With

Sarah123 · #3 11-12-2018, 06:50 PM

@AntiqueWhale, my exposure to this is limited; is this what you mean?

Sub AddImageToHeader()

Dim SrcePath As String

SrcePath = "S:\DocBase\Document Templates\Macros\New Macros Nov 2018\Letterhead.jpg"

ThisDocument.Sections.Item(1).Headers(wdHeaderFoot erPrimary) _
.Range.InlineShapes.AddPicture (SrcePath)

Dim header_pic As InlineShape
Set headerPic = ThisDocument.Sections(1).Header(wdHeaderFooterPrim ary).Range.InlineShapes.AddPicture(SrcePath)
With headerPic
.Width = 5.11
.Height = 20.96
End With

End Sub

I getting an error on this?

AntiqueWhale · #4 11-12-2018, 07:01 PM

Hi Sarah, First of all, you do not use the statement 2 times.
And it should be Headers, not Header.
And no space between wdHeaderFooterPrimary
And if you wanna use "headerPic", do not Dim "header_pic"....

the code below should work

Code:

Sub AddImageToHeader()
    Dim SrcePath As String, headerPic As InlineShape
    
    SrcePath = "S:\DocBase\Document Templates\Macros\New Macros Nov 2018\Letterhead.jpg"
    
    Set headerPic = ThisDocument.Sections.Item(1).Headers(wdHeaderFooterPrimary).Range.InlineShapes.AddPicture(SrcePath)
    
    With headerPic
        .Width = 5.11
        .Height = 20.96
    End With
End Sub

Sarah123 · #5 11-12-2018, 07:08 PM

This does work, however the the sizing of the picture is completely wrong. Then I check the the size settings and it is not even remotely what I've entered into VBA. What format do I need to enter into VBA to get the correct sizing in word in CM?

Sizing in VBA code
Height 5.11
Width 20.96

Sizing in word after macro has been run
Height 0.18cm
Width 0.74cm

AntiqueWhale · #6 11-12-2018, 07:30 PM

In VBA, the size measured in Points, you can use CentimetersToPoints function convert centimeters to points
you can use

Code:

.Width = CentimetersToPoints(20.96)
.Height = CentimetersToPoints(5.11)

Guessed · #7 11-12-2018, 07:35 PM

Sizes in Word are in Points (there are 72 points in an inch)

You can use a function to convert cm to units Word understands
.Height = CentimetersToPoints(5.11)
.Width = CentimetersToPoints(20.96)

Bringing in the graphic as an inline shape is somewhat problematic. What if the user doesn't have S drive mapped the same way? I see your preferred width is the same as an A4 page so I assume you were expecting the graphic to start at the top left of the page - you wont get this with an inline shape unless the header space is zero and then the users will get nagged about margins when printing. Are you confident the left margin is always the same in these docs?

FWIW, I would be doing this a different way. I like to save the headers and footers as building blocks in the template itself and then replace the header with that building block.

Sarah123 · #8 11-12-2018, 07:53 PM

@Guessed, thank you!

The idea if for me to build each template we have saved on this macro template, so in theory it should be ok. But any other suggestions you have would be welcomed, you obviously know more than me!

I am so having trouble with the last two sections of this code, if you have any suggestions?

Sub AddImageToHeader()
Dim SrcePath As String, headerPic As InlineShape

SrcePath = "S:\DocBase\Document Templates\Macros\New Macros Nov 2018\Letterhead.jpg"

Set headerPic = ThisDocument.Sections.Item(1).Headers(wdHeaderFoot erPrimary).Range.InlineShapes.AddPicture(SrcePath)

With headerPic
.Width = CentimetersToPoints(20.96)
.Height = CentimetersToPoints(5.11)
End With

With headerPic.WrapFormat
.Type = wdWrapBehindText
End With

With headerPic.Range
.ParagraphFormat.Alignment = wdAlignParagraphLeft
End With

End Sub

Guessed · #9 11-12-2018, 08:32 PM

You can't wrap text around an inline shape - it needs to be a floating shape. So you need to convert it to a shape if you want the text wrap setting. Shapes are not bothered with paragraph alignment so that probably won't be needed unless you are also putting text in the header.

Code:

Sub AddImageToHeader()
  Dim SrcePath As String, headerPic As InlineShape, aShp As Shape
  SrcePath = "S:\DocBase\Document Templates\Macros\New Macros Nov 2018\Letterhead.jpg"
  Set headerPic = ActiveDocument.Sections(1).Headers(wdHeaderFooterPrimary).Range.InlineShapes.AddPicture(SrcePath)
  Set aShp = headerPic.ConvertToShape
  With aShp
    .LockAspectRatio = msoTrue
    .Width = CentimetersToPoints(21)
    .RelativeHorizontalPosition = wdRelativeHorizontalPositionPage
    .RelativeVerticalPosition = wdRelativeVerticalPositionPage
    .Top = 0
    .Left = 0
    .WrapFormat.Type = wdWrapBehind
  End With
End Sub

Also, you can't use ThisDocument because it refers to the document where the macro resides (ie the template) rather than the document you thought you were running the macro on. While you are doing testing in the template you won't notice any problems but you won't get the result you are looking for once you try to run the macro on a document rather than the template.

Sarah123 · #10 11-12-2018, 08:54 PM

Thank you @Guessed - you have been a great help.

To replicate this for a footer, can I change .Top = 0 for .Bottom = 0 or is there something else I would need to change?

I have also tried Building Blocks as you have previously mentioned, thank you!

Sarah123 · #11 11-12-2018, 09:14 PM

It's getting stuck below where indicated in red

Sub AddImageToFooter()
Dim SrcePath As String, footerPic As InlineShape, aShp As Shape
SrcePath = "S:\DocBase\Document Templates\Macros\New Macros Nov 2018\Footer Pg1.jpg"
Set footerPic = ActiveDocument.Sections(1).Footers(wdHeaderFooterP rimary).Range.InlineShapes.AddPicture(SrcePath)
Set aShp = footerPic.ConvertToShape
With aShp
.LockAspectRatio = msoTrue
.Width = CentimetersToPoints(21)
.RelativeHorizontalPosition = wdRelativeHorizontalPositionPage
.RelativeVerticalPosition = wdRelativeVerticalPositionPage
.Bottom = 0
.Left = 0
.WrapFormat.Type = wdWrapBehind
End With
End Sub

AntiqueWhale · #12 11-13-2018, 07:15 AM

For vertical position, use "Top" property instead of "Bottom", there is no "Bottom" property of shape

Thread Tools
Show Printable Version Email this Page
Display Modes
Linear Mode Switch to Hybrid Mode Switch to Threaded Mode

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Header and Footer	Diablodvs7	Word	1	07-28-2015 07:54 PM
Header and footer aligned in the footer area	ashiqghfr	Word	2	07-23-2015 01:14 AM
header footer	Pierre-Hugues	Word VBA	1	08-30-2013 06:06 AM
How to resize the image in the header so that it fits the page	Isadora	Excel	1	08-20-2013 06:02 AM
Relocate footnotes to facing page	Wydeye	Word	0	02-23-2010 05:48 PM