Как я могу вставить изображение нижнего колонтитула в документ 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.