Folgendes VBA Snippet erstellt anhand der Metainformationen einer Arbeitsmappe eine Kopfzeile mit folgenden nützlichen Informationen

1. Firmen- oder Autorenname
2. Erstelldatum mit Ersteller
3. Änderungsdatum mit letztem Autor

Der Vorteil dieser Methode liegt vor allem daran, das das Arbeitsblatt komplett nutzbar bleibt. Das Makro kann einfach in einer Vorlage gespeichert und in die Schnellzugriffsleiste eingefügt werden. Wie das geht, steht hier.

Hier der Code:

Sub KopfzeileAnlegen()
'
' KopfzeileAnlegen Makro
' Legt eine Kopfzeile mit Namen, Erstell-, und Änderungsdatum an.
'
'Christian Falke, 2016


'Definiere Variablen für den Inhalt der linken und rechten Kopfzeile
Dim KopfLinks As String
Dim KopfRechts As String

'Schreibe den Inhalt der Kopfzeilen in die Variablen
KopfLinks = ActiveSheet.PageSetup.LeftHeader
KopfRechts = ActiveSheet.PageSetup.RightHeader


Dim Author As String 'Variable nimmt den Systembenutzernamen des Erstellers als Autor auf
Dim Company As String ' Wenn der Firmenname im System vorhanden ist, wird dieser links gewählt
Dim LastAuthor As String 'Variable nimmt den Systemnamen des letzten Dokumentbenutzers auf
Dim CreaDate As Date 'Variable nimmt Erstellungsdatum der Datei auf

'Autor und Datum aus Excel Metadaten auslesen
Author = ActiveWorkbook.BuiltinDocumentProperties("Author")
Company = ActiveWorkbook.BuiltinDocumentProperties("Company")
LastAuthor = ActiveWorkbook.BuiltinDocumentProperties("Last author")
CreaDate = Fix(ActiveWorkbook.BuiltinDocumentProperties("Creation Date")) 'Fix löscht die Nachkommastelle der Ganzzahl und damit die Uhrzeit


'Für Privatpersonen empfiehlt es sich den eigenen Namen in der linken Kopfzeile zu führen, daher eine Inhaltsprüfung
 If Company = "" Then

  Company = Author

 End If

'Prüft ob die Kopfzeile leer ist
 If KopfLinks & KopfRechts = "" Then
 

    With ActiveSheet.PageSetup
        .LeftHeader = Company
        .CenterHeader = ""
        .RightHeader = "Erstellt am: " & CreaDate & " von: " & Author & Chr(10) & "Geändert am: &D von: " & Author
        .LeftFooter = ""
        .CenterFooter = ""
        .RightFooter = ""
        .LeftMargin = Application.InchesToPoints(0.7)
        .RightMargin = Application.InchesToPoints(0.7)
        .TopMargin = Application.InchesToPoints(0.75)
        .BottomMargin = Application.InchesToPoints(0.75)
        .HeaderMargin = Application.InchesToPoints(0.3)
        .FooterMargin = Application.InchesToPoints(0.3)
        .Zoom = 100
        .PrintErrors = xlPrintErrorsDisplayed
        .OddAndEvenPagesHeaderFooter = False
        .DifferentFirstPageHeaderFooter = False
        .ScaleWithDocHeaderFooter = True
        .AlignMarginsHeaderFooter = True
    End With

 'Wenn nicht, wird der rechte Teil lediglich aktualisiert
 Else



    With ActiveSheet.PageSetup
        .RightHeader = "Erstellt am: " & CreaDate & " von: " & Author & Chr(10) & "Geändert am: &D von: " & Author
    End With

 End If
 
End Sub