[Excel] Mehrere Worksheets als PDF exportieren mit unterschiedlichen Seiteneinstellungen

Marciboy

Erdapfel
Registriert
02.01.20
Beiträge
1
Ich benutze Office 365 auf dem Mac. Es scheint, dass aus unerklärlichen Gründen der Druck bzw. die Erstellung eines PDF nicht möglich ist über den „normalen“ Weg, sofern jede Seite andere Einstellungen (bzgl. Seitenränder, Kopf-/ Fusszeilen, Zoom, Orientierung etc.) hat. Mit dem normalen Weg meine ich, die gewünschten Tabellen anwählen und dann einfach drucken. Macht man dies, so übernimmt es das Layout für alle Seiten basierend auf der als erstes ausgewählten Seite. Eigentlich möchte ich gar kein Makro aber in diesem Fall scheint es der einzige Workaround zu sein. Mit dem Druck habe ich es geschafft, ein Makro zu erstellen, welches jedem Worksheet einen separaten Druckauftrag zuordnet und somit nicht mit den Seiteneinstellungen komisches Zeug anstellt.

Mit dem Pdf Export will es nicht funktionieren, so wie ich das Makro programmiert haben. Meine Idee war jede Seite einzeln in den gewünschten Ordner zu exportieren und diese dann extern zu kombinieren. Ist mit ein wenig Mehraufwand verbunden, würde aber eigentlich funktionieren.
Das Problem mit folgendem Makro ist, dass es mir nur beinahe das gewünschte Resultat liefert, da die Seiteneinstellungen nach dem Export geändert werden. Die PDF's sind also richtig, jedoch wird den Worksheets andere Seiteneinstellungen zugeteilt.

Ich hoffe mein Problem verständlicher geschildert zu haben und dass mir jemand weiterhelfen kann.



Sub speichern()

Dim path As String
path = Application.ThisWorkbook.path

Dim ssh As Sheets
Set ssh = ActiveWindow.SelectedSheets

Application.ScreenUpdating = False

Dim currentSheet As Object
Dim currentSheetOrientation As XlPageOrientation
For Each currentSheet In ssh
currentSheetOrientation = currentSheet.PageSetup.Orientation
currentSheet.Copy
ActiveSheet.PageSetup.Orientation = currentSheetOrientation
ActiveSheet.ExportAsFixedFormat xlTypePDF, Filename:=path & "/" & ActiveSheet.Name
ActiveWorkbook.Close SaveChanges:=False
Next currentSheet

Application.ScreenUpdating = True

End Sub