pdf 2-seitig ausgeben
27.10.2015 10:39:26
Ralf
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