CODEWITHSUNDEEP
vbamacosms-wordms-office
tsatke
tsatke

Reputation: 159

How can I insert a footer image into a docx Document via Visual Basic? (Mac)

I got a .docx Document created with Apache POI. I opened it and tried to insert header and footer images by executing two macros:

Sub Header_Bild_Einfuegen()
    If ActiveDocument.ProtectionType <> wdNoProtection Then
        ActiveDocument.Unprotect
    End If

    Dim oShape As Shape, oRange As Range
    Dim Pfad As String
    Pfad = "C:\Users\path\to\headerIcon.jpeg"

    Set oRange =     ActiveDocument.Sections(1).Headers(wdHeaderFooterPrimary).Range
    Set oShape = ActiveDocument.Shapes.AddPicture(FileName:=Pfad, _
    LinkToFile:=False, SaveWithDocument:=True, Anchor:=oRange)

    oShape.Height = CentimetersToPoints(4.8)
    oShape.Width = CentimetersToPoints(21.55)
    oShape.Left = CentimetersToPoints(-2.44)
    oShape.Top = CentimetersToPoints(-1.28)
    oShape.ZOrder msoSendBehindText

End Sub

Sub Footer_Bild_Einfuegen()
    If ActiveDocument.ProtectionType <> wdNoProtection Then
        ActiveDocument.Unprotect
    End If
    '
    Dim oShape As Shape, oRange As Range
    Dim Pfad As String
    Pfad = "C:\Users\path\to\footerIcon.jpeg"

    Set oRange =     ActiveDocument.Sections(1).Footers(wdHeaderFooterPrimary).Range
    Set oShape = ActiveDocument.Shapes.AddPicture(FileName:=Pfad, _
    LinkToFile:=False, SaveWithDocument:=True, Anchor:=oRange)

    oShape.Height = CentimetersToPoints(2.4)
    oShape.Width = CentimetersToPoints(21.55)
    oShape.Left = CentimetersToPoints(-2.44)
    oShape.ZOrder msoSendBehindText
End Sub

My problem is: Both images are inserted into the header of the document, the footer stays empty (but exists, contains text (so does the header)). I tried to change pretty much everything, but all ended up giving me runtime errors. I even changed the variable names for Footer_Bild_Einfuegen() because I thought they might be merging both macros for any reason (No runtime error, just didn't work. It ended up the same way as it did when the variables names were equal).

It all works fine under Windows, but it fails under Mac. I have no idea what this could be caused by, maybe it's just the implmentation of VB in the Mac-Office edition (MS Office 2008 for Mac, MS Office 2016 does not work either), I don't know.

If there is no solution for this problem, is there a convenient way to insert images into the footer without having to resize them manually every time?

Thanks in advance, appreciate every answer

Upvotes: 1

Views: 1195

Answers (1)

tsatke
tsatke

Reputation: 159

I finally found a way:

Sub Finalize()
    If ActiveDocument.ProtectionType <> wdNoProtection Then
        ActiveDocument.Unprotect
    End If
    If ActiveWindow.View.SplitSpecial <> wdPaneNone Then
        ActiveWindow.Panes(2).Close
    End If
    If ActiveWindow.ActivePane.View.Type = wdNormalView Or ActiveWindow.ActivePane.View.Type = wdOutlineView Or ActiveWindow.ActivePane.View.Type = wdMasterView Then
        ActiveWindow.ActivePane.View.SeekView = wdPageView
    End If
    ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageFooter
    ActiveDocument.PageSetup.FooterDistance = InchesToPoints(1)   

    Dim oShape As Shape, oRange As Range
    Dim Pfad As String
    Pfad = "/Path/To/footerIcon.jpeg"

    Set oRange = Selection.Range
    Set oShape = ActiveDocument.Shapes.AddPicture(fileName:=Pfad,     LinkToFile:=False, SaveWithDocument:=True, Anchor:=oRange)

    oShape.Height = CentimetersToPoints(2.2)
    oShape.Width = CentimetersToPoints(21.55)
    oShape.Left = CentimetersToPoints(-2.44)
    oShape.Top = CentimetersToPoints(0.28)
    oShape.ZOrder msoSendBehindText

    'HEADER

    ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader    

    Dim ohShape As Shape, ohRange As Range
    Dim hPfad As String
    hPfad = "/Path/To/headerIcon.jpeg"

    Set ohRange = Selection.Range
    Set ohShape = ActiveDocument.Shapes.AddPicture(fileName:=hPfad, LinkToFile:=False, SaveWithDocument:=True, Anchor:=ohRange)

    ohShape.Height = CentimetersToPoints(4.6)
    ohShape.Width = CentimetersToPoints(21.55)
    ohShape.Left = CentimetersToPoints(-2.44)
    ohShape.Top = CentimetersToPoints(-1.28)
    ohShape.ZOrder msoSendBehindText

    ActiveDocument.ActiveWindow.View.Type = wdPrintView

End Sub

This way should also work under Windows.

Upvotes: 1

Related Questions