Ich habe mir ein VBA-Makro geschrieben, dass mir eine vorgegebene Fußzeile, je nach Hoch oder Querformat, automatisch in alle Dateien eines Ordners einfügt. Ich habe nun das Problem, dass die Fußzeile oft zu hoch eingefügt wird und sich dadurch der Inhalt verschiebt. Da ich es automatisieren wollte, weil es hier um mehrere tausend Dateien geht, wäre es zu aufwändig, anschließend jede Zeile von der Höhe her anzupassen.

Jetzt suche ich nach einer Lösung wie ich ins Makro einbauen kann, dass jede eingefügte Fußzeile automatisch auch noch in der Position formatiert wird.
Unter der Registerkarte Kopf- und Fußzeile im Reiter Position "Fußzeile von unten" wäre 0,2cm ideal, dass es in allen Dateien passt und sich der Inhalt nicht verschiebt.

Sub BearbeiteDateien()
    Dim folderPath As String
    Dim templatePathPortrait As String
    Dim templatePathLandscape As String
    Dim templateDocPortrait As Document
    Dim templateDocLandscape As Document
    Dim file As String

    ' Pfade anpassen
    folderPath = "C:\Users\sbutz\Desktop\Test docx neu\"  ' Passe den Pfad zum Ordner an, in dem sich die Dateien befinden
    templatePathPortrait = "C:\Users\sbutz\Desktop\Fußzeile Hochformat.docx"  ' Passe den Pfad zur Word-Datei mit der Fußzeile für Hochformat an
    templatePathLandscape = "C:\Users\sbutz\Desktop\Fußzeile Querformat.docx"  ' Passe den Pfad zur Word-Datei mit der Fußzeile für Querformat an

    ' Lade die Vorlagen
    Set templateDocPortrait = Documents.Open(templatePathPortrait)
    Set templateDocLandscape = Documents.Open(templatePathLandscape)

    ' Iteriere durch alle Word-Dokumente im angegebenen Ordner
    file = Dir(folderPath & "\*.doc*")
    Do While file <> ""
        ' Bearbeite Word-Dokument
        BearbeiteWordDatei folderPath & "\" & file, templateDocPortrait, templateDocLandscape
        file = Dir
    Loop

    ' Schließe die Vorlagen
    templateDocPortrait.Close SaveChanges:=False
    templateDocLandscape.Close SaveChanges:=False
    Set templateDocPortrait = Nothing
    Set templateDocLandscape = Nothing

    MsgBox "Fertig!"
End Sub

Sub BearbeiteWordDatei(filePath As String, templateDocPortrait As Document, templateDocLandscape As Document)
    Dim doc As Document
    Dim orientation As String

    ' Lade das Word-Dokument
    Set doc = Documents.Open(filePath)

    ' Bestimme die Ausrichtung des Dokuments
    orientation = doc.PageSetup.orientation
    
    ' Füge die entsprechende Fußzeile ein
    If orientation = wdOrientPortrait Then
        templateDocPortrait.Sections(1).Footers(wdHeaderFooterPrimary).Range.Copy
    ElseIf orientation = wdOrientLandscape Then
        templateDocLandscape.Sections(1).Footers(wdHeaderFooterPrimary).Range.Copy
    End If

    doc.Sections(1).Footers(wdHeaderFooterPrimary).Range.Paste

    ' Speichere das aktualisierte Dokument
    doc.Save
    doc.Close SaveChanges:=False
    Set doc = Nothing
End Sub