Clever-Excel-Forum

Hallo zusammen,

habe mal wieder ein Problem womit ich nicht weiter komme.
Aus dem Netz habe ich ein tolles Makro (danke an den Urheber) das mir Daten in die Kopf- und Fußzeile einer Tabelle schreibt.
Es gelingt mir aber nicht das Teil so abzuändern, dass auf der letzten Seite der "RightFooter" ein anderer Eintrag eingefügt werden kann.
Es werden immer auf allen Seiten der zuvor eingetragene Text überschrieben.
Gibt es dazu eine mögliche Lösung?

Hier das Makro:

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

   Dim Startseite

   '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

   Startseite = 1

   '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

   AnzSeiten = ActiveSheet.PageSetup.Pages.Count

   '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

   For i = Startseite To AnzSeiten

      'Left=Links; Center=Mitte; Right=Rechts

      'Header=Kopfzeile; Footer=Fußzeile

      If Startseite = AnzSeiten Then

         With ActiveSheet.PageSetup

            ' Kopf und Fusszeile auf der letzten Seite ändern.

            'Fußzeile Rechts

            ActiveSheet.PageSetup.RightFooter = "Stopp"

         End With

      Else

         ' Kopf- und Fußzeile für erste bis vorletzte Seite

         'Prüft ob die Kopfzeile leer ist

         If KopfLinks & KopfRechts = "" Then

            With ActiveSheet.PageSetup

               .FirstPageNumber = Startseite

               'Inhalt der ersten Zelle (A1) als Überschrift in der Kopfzeile

               '.LeftHeader = Company

               .LeftHeader = "&""ARIAL,Fett""&12" & Range("A1")

               .CenterHeader = ""

               .RightHeader = "Erstellt am: " & CreaDate & Chr(10) & "Geändert am: &D"

               '.RightHeader = "Erstellt am: " & CreaDate & " von: " & Author & Chr(10) & "Geändert am: &D von: " & Author

               .LeftFooter = "X. XXXXXX"

               .CenterFooter = " Seite &p von &n"

               .RightFooter = "weiter lesen ....."

               .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 & Chr(10) & "Geändert am: &D"

               '.RightHeader = "Erstellt am: " & CreaDate & " von: " & Author & Chr(10) & "Geändert am: &D von: " & Author

            End With

         End If

      End If

      Startseite = Startseite + 1

   Next

End Sub

Vielen Dank für Eure Hilfe!

Das geht auch nicht, nur die erste Seite kann einen anderen Eintrag bekommen als alle anderen Seiten.

Schade, aber gäbe es noch eine andere Möglichkeit die Kopf- oder Fusszeile der letzten Seite anders zu beschreiben?

Hi,

nein, das ist von MS nicht vorgesehen.

Vielen Dank für die Antwort!

Na ja vielleicht hat ja MS im Jahr 3000 neue Ideen Blush

Nun, an Ideen wird es MS wohl nicht mangeln. ABer wie sagt ein Sprichwort? Einem jeden Recht getan, ist eine Kunst, die niemand kann.

Wenn es nur um den Ausdruck geht, könntest du das Makro so schreiben, dass beim Druck alle bis auf die letzte Seite ausgedruckt werden, dann die Kopfzeile wie gewünscht geändert wird und die letzte Seite gedruckt wird. Anschließend die Kopfzeile wieder zurücksetzen.
Ist halt von hinten durch die Brust ins Auge und nützt auch nix, wenn die Datei als pdf exportiert wird. Aber es ist eine Möglichkeit.

Danke, so hatte ich mir in der Not auch geholfen. Aber wie Du sagtest wenn man dann pdf benötigt wird es umständlich.
Ist halt schade wenn rudimentäre Dinge nicht funktionieren.
In Word kann man die Kopf- und Fußzeile ja auch nach Bedürfnis gestalten.

Bitte hier nicht Äpfel mit Birnen vergleichen. Excel ist kein Textverarbeitungsprogramm.

Das ist mir schon klar.
Tabellen sind aber schon auch ein Dokumentations-Werkzeug.

Nun es ist halt so, man braucht sich nicht ärgern, aber wundern tue ich mich schon.
Werde es überleben.

sharky51

MisterBurns

sharky51

WillWissen

sharky51

MisterBurns

sharky51

MisterBurns

sharky51