Image does not move higher in Word 2010 with Macro

Hi all,

I have created a Macro in Word 2010 to input an image as a header and footer for our company. The only thing is, the header image needs to be 1cm (in A4 paper terms) from the top of the page. Yet it is slightly lower. In the macro I have written Selection.ShapeRange.Top = PixelsToPoints(0). Although this is set to 0 it still hasn't made the image higher. I would appreciate it if I could get help on how to do this. Below is my full Macro:

Sub BucklesTemplate()
'
' BucklesTemplate Macro
' Macro coded 20/05/2014 by Rajan Kandola
'
'Auto tick Different First Page
ActiveDocument.PageSetup.DifferentFirstPageHeaderFooter = True
'switch to header
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
'add logo to header
With ActiveDocument.Shapes.AddPicture(Anchor:=Selection.Range, _
    FileName:="C:\Users\kandolar.BUCKLEMELLOWS\Desktop\Buckles Letter Format\logo.jpg", _
    LinkToFile:=False, SaveWithDocument:=True)
    .WrapFormat.Type = 3
    .ZOrder 4
End With
'select the last item in shapes list - should be logo that was just added
Selection.HeaderFooter.Shapes(Selection.HeaderFooter.Shapes.Count).Select
'set relative vertical position to Page So that it will stay in the header
Selection.ShapeRange.Top = PixelsToPoints(0)
'reposition the logo - to test I moved them horizontally to about the center of the page
Selection.ShapeRange.Left = PixelsToPoints(210)

'switch to footer
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageFooter
'add banner to footer
With ActiveDocument.Shapes.AddPicture(Anchor:=Selection.Range, _
    FileName:="C:\Users\kandolar.BUCKLEMELLOWS\Desktop\Buckles Letter Format\disclaimer+btmBanner.jpg", _
    LinkToFile:=False, SaveWithDocument:=True)
    .WrapFormat.Type = 3
    .ZOrder 4
    .LockAspectRatio = False
    'change size of footer image
    .Height = InchesToPoints(1.3)
    .Width = InchesToPoints(8.31)
    'make footer image relative to margin
    .WrapFormat.Type = wdRelativeVerticalPositionMargin
End With
'select the last item in shapes list - should be logo that was just added
Selection.HeaderFooter.Shapes(Selection.HeaderFooter.Shapes.Count).Select
'set relative vertical position to Page So that it will stay in the footer
Selection.ShapeRange.Top = PixelsToPoints(980)
'reposition the logo - to test I moved them horizontally to about the center of the page
Selection.ShapeRange.Left = PixelsToPoints(0)

'switch back to main document
ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument

End Sub

Many Thanks,

Rajan

This thread is locked. You can vote as helpful, but you cannot reply or subscribe to this thread.

Answer

Graham Mayor

You don't have to open the header or footer to process them and you need to set the header margin to 0 if you want to move the shape closer to the top e.g. as follows. I'll assume your other settings are correct.

Sub BucklesTemplate()
Dim oDoc As Document
Dim oHeader As HeaderFooter
Dim oFooter As HeaderFooter
Dim oShape As Shape
    Set oDoc = ActiveDocument
    oDoc.PageSetup.HeaderDistance = CentimetersToPoints(0)
    oDoc.PageSetup.FooterDistance = CentimetersToPoints(0)
    Set oHeader = oDoc.Sections(1).Headers(wdHeaderFooterFirstPage)
    Set oFooter = oDoc.Sections(1).Footers(wdHeaderFooterFirstPage)

    oDoc.Sections(1).PageSetup.DifferentFirstPageHeaderFooter = True

    Set oShape = oHeader.Shapes.AddPicture(Anchor:=oHeader.Range, _
     Filename:="C:\Users\kandolar.BUCKLEMELLOWS\Desktop\Buckles Letter Format\logo.jpg", _
     LinkToFile:=False, SaveWithDocument:=True)

    With oShape
        .WrapFormat.Type = 3
        .ZOrder 4
        .Top = PixelsToPoints(0)
        .Left = PixelsToPoints(210)
    End With

    Set oShape = oFooter.Shapes.AddPicture(Anchor:=oFooter.Range, _
     Filename:="C:\Users\kandolar.BUCKLEMELLOWS\Desktop\Buckles Letter Format\disclaimer+btmBanner.jpg", _
     LinkToFile:=False, SaveWithDocument:=True)

    With oShape
        .WrapFormat.Type = 3
        .ZOrder 4
        .LockAspectRatio = False
        .Height = InchesToPoints(1.3)
        .Width = InchesToPoints(8.31)
        .WrapFormat.Type = 3
        .Left = PixelsToPoints(0)
        .Top = PixelsToPoints(980)
    End With
End Sub

Graham Mayor (Microsoft Word MVP 2002-2019)
For more Word tips and downloads visit my web site
https://www.gmayor.com/Word_pages.htm

Contribute to the Microsoft 365 and Office forum!

Word Forum Top Contributors:

Image does not move higher in Word 2010 with Macro

Replies (2)

Question Info

Image does not move higher in Word 2010 with Macro

Replies (2) 

Question Info

Replies (2)