Как я могу вставить изображение нижнего колонтитула в документ DOCX через Visual Basic? (Mac)

Я получил документ.docx, созданный с помощью Apache POI. Я открыл его и попытался вставить изображения верхнего и нижнего колонтитула, выполнив два макроса:

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

Моя проблема: оба изображения вставляются в верхний колонтитул документа, нижний колонтитул остается пустым (но существует, содержит текст (как и заголовок)). Я пытался изменить почти все, но все закончилось тем, что я выдавал ошибки во время выполнения. Я даже изменил имена переменных для Footer_Bild_Einfuegen() потому что я думал, что они могут объединить оба макроса по любой причине (нет ошибки времени выполнения, просто не сработало. Все закончилось так же, как и при одинаковых именах переменных).

Все работает нормально под Windows, но не работает под Mac. Я понятия не имею, чем это может быть вызвано, может быть, это просто внедрение VB в версии Mac-Office (MS Office 2008 для Mac, MS Office 2016 тоже не работает), я не знаю.

Если решения этой проблемы не существует, существует ли удобный способ вставки изображений в нижний колонтитул без необходимости каждый раз изменять их размер вручную?

Спасибо заранее, ценю каждый ответ

1 ответ

Решение

Я наконец нашел способ:

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

Этот способ также должен работать под Windows.

Другие вопросы по тегам