Mehrere Arbeitsblätter zusammen drucken

[Kuwer]

Noch ein Versuch:

Sub speichern()

    '

    ' speichern Makro

    '

    ' Tastenkombination: Strg+s

    '

    ' PDF Export Macro

     

    Dim ws As Worksheet

    Dim ssh As Object

    Dim path As String

    

    path = Application.ThisWorkbook.path

    Set ssh = ActiveWindow.SelectedSheets

    For Each ws In ssh

        Application.PrintCommunication = False

        ws.Select

        Application.PrintCommunication = True

        ws.ExportAsFixedFormat xlTypePDF, Filename:=path & "/" & ws.Name

    Next ws

    Sheets("Daten").Select

End Sub

Gruß Uwe

[Marcinoy]

 leider nein selbes Resultat

[schauan]

Hallöchen,

hattest Du denn auf jedem Blatt schon mal das Layout eingestellt? Wenn nicht, dann ist das so korrekt.

Anbei mal eine Datei, wo ich Hoch- und Querformat eingestellt habe. Bitte z.B. Tabelle1 bis 3 vor Makroausführung selektieren, oder auch nur ein oder zwei Blätter.
Tabelle1 sollte quer kommen, die anderen beiden hoch. Klappt bei mir jedenfalls...

Code ist der von Uwe enthalten, leicht geändert:

Code:

Option Explicit
Sub speichern()
   '
   ' speichern Makro
   '
   ' Tastenkombination: Strg+s
   '
   ' PDF Export Macro
   
   Dim ws As Worksheet
   Dim ssh As Object
   Dim path As String
   path = Application.ThisWorkbook.path
   Set ssh = ActiveWindow.SelectedSheets
   Sheets("Daten").Select
   For Each ws In ssh
       ws.Select
       ws.ExportAsFixedFormat xlTypePDF, Filename:=path & "/" & ws.Name
   Next ws
   ssh.Select
End Sub

[Marcinoy]

Ja auch bei diesem Dokument das selbe Problem. Meine Layout Einstellungen müssen richtig sein, wähle ich nämlich nur ein Worksheet aus Dann habe ich das gewünschte Format.

[Marcinoy]

Neu Lösung mit neuen Problemen.
Gut: Worksheets werden nun mit der richtigen Orientierung, dem richtigen Namen und am richtigen Ort gespeichert. 
Schlecht: Die Farben der Zellen im PDF sind anders als im Worksheet und nach dem Export ändert sich die Orientierung der Seite in den Worksheets.

Code:

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
       Application.Wait Now + TimeValue("0:00:03")
       ActiveSheet.PageSetup.Orientation = currentSheetOrientation
       ActiveSheet.ExportAsFixedFormat xlTypePDF, Filename:=path & "/" & ActiveSheet.Name
       ActiveWorkbook.Close SaveChanges:=False
   Next currentSheet
   
   Application.ScreenUpdating = True
   
End Sub

[schauan]

Hallöchen,

ach dem Export ändert sich die Orientierung der Seite in den Worksheets.

Du hast die Orientierung ja in einer Variable. Dann setze sie doch nach dem Export nochmal...

[Marcinoy]

Wie genau würdest du dies tun?

[schauan]

.. Na am Ende der Schleife und anders rum als beim auslesen.

[Marcinoy]

also so? wenn ja dann funktioniert nicht

Code:

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
      Application.Wait Now + TimeValue("0:00:03")
      ActiveSheet.PageSetup.Orientation = currentSheetOrientation
      ActiveSheet.ExportAsFixedFormat xlTypePDF, FileName:=path & "/" & ActiveSheet.Name
      ActiveWorkbook.Close SaveChanges:=False
      currentSheet.PageSetup.Orientation = currentSheetOrientation
  Next currentSheet
 
  Application.ScreenUpdating = True
 
End Sub

[schauan]

Hallöchen,
Was bedeutet denn nun funktioniert nicht?