PDF erstellen

Hallo zusammen,
hier ist wieder Susy...natürlich mit einem Problem, und da ich es nicht lösen kann, bitte ich um eure Hilfe.
Ich habe versucht mir für das folgende Problem ein Makro zu basteln (ohne Erfolg).
Ich habe eine Mappe, Name = Beispiel. In dieser Mappe sind 10 Tabellen. Tabelle1, Tabelle2 ... usw. Meine Aufgabe besteht nun darin, aus Tabelle1 bis Tabelle6 eine PDF-Datei zu erstellen. Tabelle1 ist das Deckblatt. In der Fußzeile links soll das aktuelle Druckdatum stehen, in der Mitte -Test- und rechts bleibt leer. In Tabelle2 bis Tabelle6 soll in der Fußzeile das gleiche stehen, zusätzlich rechts unten fortlaufend die Seitenzahl: Seite 1 von Seite X. Das Problem ist, das Excel immer alle Seiten zählt. Bei 6 Seiten also Seite 1 von Seite 6. Dabei soll die erste Seite keine Seitenzahl haben und Seite 2 wird zu Seite 1. Also müsste auf der letzten Seite - Seite 5 von Seite 5 stehen. Dazu kommt noch, dass die Tabellen4 bis 6 unterschiedlich viele Seiten haben können, z. B. Tabelle4 = 2 Seiten, Tabelle5 = 4 Seiten, Tabelle6 = 1 Seite usw. Tabelle2 hat immer nur eine Seite, dafür aber im Querformat. Alle anderen sind im Längsformat. Sobald aber eine Tabelle mehr als eine Seite hat, sind die Seitenzahlen völlig durcheinander.
Ich möchte gerne, dass ein Makro die Anzahl der Seiten ermittelt und wie beschrieben die Daten in die Fußzeile einträgt, bevor ein PDF erstellt wird. Ist das möglich?
Ich hoffe, ich habe alles verständlich beschrieben.
Vielen Dank im Voraus.
LG Susy

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Susy,
man kann alle erforderlichen Einstellungen für die gewünschte Fusszeile und Seitenzählung im Seiten-Layout machen.
Im Seiten-Layot unter benutzerdefinierte Fusszeile für alle Blätter:
Für das Datum links kann man die Feldfunktion verwenden, so dass das Datum automatisch = aktuelles Datum ist, den Text in der Mitte einfach eintippen.
Im Seiten-Layot unter benutzerdefinierte Fusszeile für Blätter 2 bis 6:
Für die Seitennummerierung rechts muss man etwas tricksen, damit von der Gesamtseitenzahl 1 für das Deckblatt abgezogen wird. Der Eintrag muss wie folgt sein:

&[Seite] von &(&[Seiten]-1&)

Im Seiten-Layot unter Papierformat für Blatt 2:
Die 1. Seitenzahl muss auf 1 gesetzt werden.
Das nachfolgende Makro fragt nach dem Namen/Speicherort für die PDF-Datei, führt das PageSetup aus, gruppiert die als PDF-zu speichernden Blätter, speichert das PDF, löst die Gruppierung weder auf.
Wenn an dem Seitenlayout nicht "rumgespielt wird, dann muss man es nur einmal einrichten. Anschliessend kann das Makro dann ohne das relativ langsam Pagesetup ausgeführt werden.
Gruß
Franz

Sub PageSetup_PDF_erzeugen()
Dim arrWks(1 To 6) As Variant, intWks As Integer, wks As Worksheet
Dim varPDF_File As Variant
With ActiveWorkbook
'vorläufiger Name für PDF-Datei - ggf anpassen
varPDF_File = .Path & "\" & Left(.Name, InStrRev(.Name, ".") - 1) _
& Format(Now, " YYYY-MM-DD hhmmss") & ".pdf"
End With
'Auswahldialog anzeigen
varPDF_File = Application.GetSaveAsFilename(InitialFileName:=varPDF_File, _
Filefilter:="PDF (*.pdf),*.pdf", _
Title:="Name für PDF-Datei eingeben/wählen")
If varPDF_File = False Then Exit Sub
'Blattnamen anpassen !!!!
arrWks(1) = "Ausgabe" 'Deckblatt
arrWks(2) = "Historie" '2. Blatt - Querformatseite
arrWks(3) = "AWL"   '3. Tabellenblatt
arrWks(4) = "Art 1" '4. Tabellenblatt
arrWks(5) = "Art 2" '5. Tabellenblatt
arrWks(6) = "Art 3" '6. Tabellenblatt
For intWks = 1 To UBound(arrWks)
Set wks = ActiveWorkbook.Sheets(arrWks(intWks))
With wks.PageSetup
.LeftFooter = " &D"  'Leerzeichen oder anderer Text vor dem Datum _
zwingend  erforderlich. Excel stürzt sonst ab
.CenterFooter = "- Test -"
Select Case intWks
Case 1
.RightFooter = ""
.FirstPageNumber = xlAutomatic
Case 2
.FirstPageNumber = 1 'Nummer 1. Seite auf Blatt 2
.RightFooter = "&P von &(&N-1&)"
Case 3 To 6
.FirstPageNumber = xlAutomatic
.RightFooter = "&P von &(&N-1&)"
End Select
End With
Next intWks
'Als PDF zu speichernde Blätter gruppieren
ActiveWorkbook.Worksheets(arrWks).Select
'Parameter, z.B. Includedocproperties/OpenAfterPublish ggf. anpassen
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=varPDF_File, _
Quality:=xlQualityStandard, Includedocproperties:=True, Ignoreprintareas:=False, _
Openafterpublish:=True
'Gruppierung der Blätter wieder aufheben
ActiveWorkbook.Sheets(arrWks(1)).Select
End Sub

Beliebteste Forumthreads (12 Monate)

4 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread