pdf 2-seitig ausgeben

Bild

Betrifft: pdf 2-seitig ausgeben
von: Ralf
Geschrieben am: 27.10.2015 10:39:26

Hallo Forum,
ich erstelle mit folgendem Code pdf Ausleitungen aus einer Tabelle:
Diese Arbeitsmappe
Option Explicit

Private Sub Workbook_Open()
    Dim wks As Worksheet
    Sheets("Auswahl").Select
    Call Tabellenblatt_entsperren
       
    Dim WSHShell As Object
    Dim strDesktopPath As String
    Set WSHShell = CreateObject("wscript.Shell")
    strDesktopPath = WSHShell.SpecialFolders.Item("Desktop")
    Sheets("Temp").Select
    Call Tabellenblatt_entsperren
    Sheets("Temp").Range("C8") = strDesktopPath
    
    'Zoomfaktor 100%
    ActiveWindow.Zoom = 100
    'Anzeige der Seitenumbrüche entfernen
    ActiveSheet.DisplayPageBreaks = False
    
    Range("A2").Select
    
    Call Dateieigenschaften
    
    Sheets("Auswahl").Activate
    
    ActiveWindow.Zoom = 100
    
End Sub

Modul
Sub Desktoppfad_schreiben()

Dim WSHShell As Object
Dim strDesktopPath As String
Set WSHShell = CreateObject("wscript.Shell")
strDesktopPath = WSHShell.SpecialFolders.Item("Desktop")
Sheets("Temp").Select
Call Tabellenblatt_entsperren
Sheets("Temp").Range("C8") = strDesktopPath
End Sub
Tabelle1 (Verfahren1)
Sub Tabelle1AlsPDF()
'Bildschirmaktualisierung aus
Application.ScreenUpdating = False

Sheets("Verfahren1").Select

Call Tabellenblatt_entsperren

ActiveSheet.PageSetup.PrintArea = ""

Select Case Worksheets("Auswahl").Range("B14").Value
Case 1: With ActiveSheet.PageSetup
.RightHeader = ""
.CenterFooter = ""
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = "&""Arial,Standard""&10Ersteller: " & Environ("UserName") & Chr(10) & "Datum: " & Format(ActiveWorkbook.BuiltinDocumentProperties(12), "DD.MM.YYYY")
.LeftFooter = "Erstellt mit Version " & Sheets("Info").Range("B1").Value & " vom " & Sheets("Info").Range("B2").Value
.CenterFooter = "&""Arial,Standard""&10Seite &P von &N"
End With
Case 2: With ActiveSheet.PageSetup
.RightHeader = ""
.CenterFooter = ""
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = "&""Arial,Standard""&10Creator: " & Environ("UserName") & Chr(10) & "Date: " & Format(ActiveWorkbook.BuiltinDocumentProperties(12), "MM-DD-YYYY")
.LeftFooter = "Created with Version " & Sheets("Info").Range("B1").Value & " dated " & Sheets("Info").Range("B14").Value
.CenterFooter = "&""Arial,Standard""&10Page &P of &N"
End With
Case Else
End Select

'Druckbereich festlegen
ActiveSheet.PageSetup.PrintArea = "A1:F56"

'Tabellenblatt temporär kopieren
ActiveWorkbook.Sheets(Array("Verfahren1")).Copy
ActiveWorkbook.ExportAsFixedFormat _
Type:=xlTypePDF, Filename:=Sheets("Verfahren1").Range("B44"), _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=True
ActiveWorkbook.Close Savechanges:=False

Sheets("Verfahren1").Select
Range("A1").Select

'Druckbereich aufheben
'ActiveSheet.PageSetup.PrintArea = ""

'Anzeige der Seitenumbrüche entfernen
ActiveSheet.DisplayPageBreaks = False

Call Tabellenblatt_sperren

End Sub
Jetzt soll der Code so erweitert/verändert werden, dass eine 2. Tabelle
Name: Tabelle8 (Verfahren1_Auswertung)
Druckbereich: A1:T30
Seitenausrichtung: Querformat
Kopf- und Fusszeilen analog Seite 1
aus der Arbeitsmappe in die temporäre Arbeitsmappe kopiert wird und dann die gesamte Arbeitsmappe als pdf extrahiert wird (2 Seiten pdf). Die 1. Seite ist im Hochformat auszugeben, die 2. im Querformat.
Wer kann mir bitte helfen den Code entsprechend anzupassen?
Vielen Dank im Voraus für eine Rückmeldung.
Viele Grüße
Ralf

Bild

Betrifft: AW: pdf 2-seitig ausgeben
von: fcs
Geschrieben am: 31.10.2015 02:00:17
Hallo Ralf,
mit beiden Blättern im PDF kann es etwa wie folgt aussehen.
Je nachdem wie die anderen aufgerufenen Makros aussehen bzw. für das 2. Blatt erforderlich sind, kann man noch ein paar Zeilen weglassen/vereinfachen.
Gruß
Franz

'Tabelle1 (Verfahren1)
Sub Tabelle1AlsPDF()
    Dim wkbPDF As Workbook, wkbActive As Workbook
    'Bildschirmaktualisierung aus
    Application.ScreenUpdating = False
    Set wkbActive = ActiveWorkbook
    
    With wkbActive.Sheets("Verfahren1")
        .Select
    
        Call Tabellenblatt_entsperren
    
        'Druckbereich festlegen
        .PageSetup.PrintArea = "A1:F56"
        
        Call prcPageSetup(Sheets(.Name))
    
        'Tabellenblatt temporär kopieren
        .Copy
        Set wkbPDF = ActiveWorkbook
        
        wkbActive.Activate
        .Select
        .Range("A1").Select
        
        'Druckbereich aufheben
        'ActiveSheet.PageSetup.PrintArea = ""
        
        'Anzeige der Seitenumbrüche entfernen
        .DisplayPageBreaks = False
        
        Call Tabellenblatt_sperren
    End With
    
    With wkbActive.Sheets("Verfahren1_Auswertung")
        .Select
    
        Call Tabellenblatt_entsperren '???? erforderlich
    
        'Druckbereich festlegen
        With .PageSetup
            .PrintArea = "A1:T30"
            .Orientation = xlLandscape
        End With
        
        Call prcPageSetup(Sheets(.Name))
        
        'Tabellenblatt temporär kopieren
        .Copy after:=wkbPDF.Sheets(1)
        
        wkbActive.Activate
        .Select
        .Range("A1").Select
        
        'Druckbereich aufheben
        'ActiveSheet.PageSetup.PrintArea = ""
        
        'Anzeige der Seitenumbrüche entfernen
        .DisplayPageBreaks = False  '??? erforderlich
        
        Call Tabellenblatt_sperren  '??? erforderlich
    End With
    
    wkbPDF.ExportAsFixedFormat _
        Type:=xlTypePDF, Filename:=wkbPDF.Sheets("Verfahren1").Range("B44"), _
        Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, _
        IgnorePrintAreas:=False, _
        OpenAfterPublish:=True
    wkbPDF.Close Savechanges:=False
    
    Application.ScreenUpdating = True
End Sub
Private Sub prcPageSetup(wks As Worksheet)
    wks.PageSetup.PrintArea = ""
    
    Select Case Worksheets("Auswahl").Range("B14").Value
    Case 1
        With wks.PageSetup
            .RightHeader = ""
            .CenterFooter = ""
            .LeftHeader = ""
            .CenterHeader = ""
            .RightHeader = "&""Arial,Standard""&10Ersteller: " _
                & Environ("UserName") & Chr(10) & "Datum: " _
                & Format(ActiveWorkbook.BuiltinDocumentProperties(12), "DD.MM.YYYY")
            .LeftFooter = "Erstellt mit Version " & Sheets("Info").Range("B1").Value _
                & " vom " & Sheets("Info").Range("B2").Value
            .CenterFooter = "&""Arial,Standard""&10Seite &P von &N"
        End With
    Case 2
        With wks.PageSetup
            .RightHeader = ""
            .CenterFooter = ""
            .LeftHeader = ""
            .CenterHeader = ""
            .RightHeader = "&""Arial,Standard""&10Creator: " _
                & Environ("UserName") & Chr(10) & "Date: " _
                & Format(ActiveWorkbook.BuiltinDocumentProperties(12), "MM-DD-YYYY")
            .LeftFooter = "Created with Version " & Sheets("Info").Range("B1").Value _
                & " dated " & Sheets("Info").Range("B14").Value
            .CenterFooter = "&""Arial,Standard""&10Page &P of &N"
        End With
    Case Else
    End Select
End Sub


Bild

Betrifft: AW: pdf 2-seitig ausgeben
von: Ralf
Geschrieben am: 02.11.2015 06:42:47
Hallo Franz,
hat super funktioniert. Genauso habe ich mir das vorgestellt.
Vielen Dank.
Viele Grüße
Ralf

 Bild

Beiträge aus den Excel-Beispielen zum Thema "pdf 2-seitig ausgeben"