Tabellenblätter in PDF-Datei drucken - Einzel- und Seriendruck

Tabellenblätter in PDF-Datei drucken - Einzel- und Seriendruck via PDFCreator
PDFCreator ist ein kostenloses Programm, um auf einfache Weise PDF's aus jeder beliebigen Anwendung
zu erstellen.
PDFCreator wird unter der GPL (GNU General Public License) veröffentlicht. Downloadmöglichkeit unter:
sourceforge.net/projects/pdfcreator/
Mit Hilfe von VBA kann man Tabellenblätter z.B. automatisiert in Serie drucken. Nach der Installation von
PDFCreator fügt man im VBA-Bereich einen Verweis auf das Objekt PDFCreator hinzu:
Menu Extras - Verweise - durchsuchen.
Unter Dateityp "ausführbare Dateien" oder "alle Dateien" wählen. "PDFCreator.exe" suchen und auswählen.
Einzelnes Arbeitsblatt als einzelne PDF-Datei drucken:
Sub PrintToPDF_Early()
Dim pdfjob As PDFCreator.clsPDFCreator
Dim sPDFName As String
Dim sPDFPath As String
'PDF-Dateinamen festlegen
sPDFName = "Dateiname.pdf"
sPDFPath = ActiveWorkbook.Path & Application.PathSeparator
'Prüfung ob das Arbeitsblatt leer ist; wenn ja dann Programm-Ende
If IsEmpty(ActiveSheet.UsedRange) Then Exit Sub
Set pdfjob = New PDFCreator.clsPDFCreator
With pdfjob
'Sicherstellen, dass der PDFCreator startet
If .cStart("/NoProcessingAtStartup") = False Then
MsgBox "Can't initialize PDFCreator.", vbCritical + vbOKOnly, "PrtPDFCreator"
Exit Sub
End If
'Standardwerte setzen
.cOption("UseAutosave") = 1
.cOption("UseAutosaveDirectory") = 1
.cOption("AutosaveDirectory") = sPDFPath
.cOption("AutosaveFilename") = sPDFName
.cOption("AutosaveFormat") = 0 ' 0 = PDF
.cClearCache
End With
'PDF drucken
ActiveSheet.PrintOut copies:=1, ActivePrinter:="PDFCreator"
'Warten, bis der Druckjob zum Drucken gekommen ist
Do Until pdfjob.cCountOfPrintjobs = 1
DoEvents
Loop
pdfjob.cPrinterStop = False
'Warten, bis PDFCreator gedruckt hat; dann Freigabe des Objekts
Do Until pdfjob.cCountOfPrintjobs = 0
DoEvents
Loop
pdfjob.cClose
Set pdfjob = Nothing
End Sub
 
Mehrere Arbeitsblätter als einzelne PDF-Dateien drucken:
Sub PrintToPDF_MultiSheet_Early()
Dim pdfjob As PDFCreator.clsPDFCreator
Dim sPDFName As String
Dim sPDFPath As String
Dim lSheet As Long
Set pdfjob = New PDFCreator.clsPDFCreator
sPDFPath = ActiveWorkbook.Path & Application.PathSeparator
'Sicherstellen, dass der PDFCreator startet
If pdfjob.cStart("/NoProcessingAtStartup") = False Then
MsgBox "Can't initialize PDFCreator.", vbCritical + vbOKOnly, "PrtPDFCreator"
Exit Sub
End If
For lSheet = 1 To ActiveWorkbook.Sheets.Count
'Prüfung ob das Arbeitsblatt leer ist; wenn ja dann Programm-Ende
If Not IsEmpty(ActiveSheet.UsedRange) Then
With pdfjob
'PDF-Dateinamen festlegen
sPDFName = "Dateiname_" & Sheets(lSheet).Name & ".pdf"
'Standardwerte setzen
.cOption("UseAutosave") = 1
.cOption("UseAutosaveDirectory") = 1
.cOption("AutosaveDirectory") = sPDFPath
.cOption("AutosaveFilename") = sPDFName
.cOption("AutosaveFormat") = 0 ' 0 = PDF
.cClearCache
End With
'PDF drucken
Worksheets(lSheet).PrintOut copies:=1, ActivePrinter:="PDFCreator"
'Warten, bis der Druckjob zum Drucken gekommen ist
Do Until pdfjob.cCountOfPrintjobs = 1
DoEvents
Loop
pdfjob.cPrinterStop = False
'Warten, bis PDFCreator gedruckt hat; dann Freigabe des Objekts
Do Until pdfjob.cCountOfPrintjobs = 0
DoEvents
Loop
End If
Next lSheet
pdfjob.cClose
Set pdfjob = Nothing
End Sub
 
Mehrere Arbeitsblätter als eine PDF-Datei drucken:
Sub PrintToPDF_MultiSheetToOne_Early()
Dim pdfjob As PDFCreator.clsPDFCreator
Dim sPDFName As String
Dim sPDFPath As String
Dim lSheet As Long
Dim lTtlSheets As Long
'PDF-Dateinamen festlegen
sPDFName = "Dateiname.pdf"
sPDFPath = ActiveWorkbook.Path & Application.PathSeparator
Set pdfjob = New PDFCreator.clsPDFCreator
'Sicherstellen, dass der PDFCreator startet
If pdfjob.cStart("/NoProcessingAtStartup") = False Then
MsgBox "Can't initialize PDFCreator.", vbCritical + vbOKOnly, "Error!"
Exit Sub
End If
'Standardwerte setzen
With pdfjob
.cOption("UseAutosave") = 1
.cOption("UseAutosaveDirectory") = 1
.cOption("AutosaveDirectory") = sPDFPath
.cOption("AutosaveFilename") = sPDFName
.cOption("AutosaveFormat") = 0 ' 0 = PDF
.cClearCache
End With
lTtlSheets = Application.Sheets.Count
For lSheet = 1 To Application.Sheets.Count
On Error Resume Next 'Errorhandling wegen Diagrammen
'Prüfung ob das Arbeitsblatt leer ist
If Not IsEmpty(Application.Sheets(lSheet).UsedRange) Then
'PDF drucken
Application.Sheets(lSheet).PrintOut copies:=1, ActivePrinter:="PDFCreator"
Else
lTtlSheets = lTtlSheets - 1
End If
On Error GoTo 0
Next lSheet
'Warten, bis alle Druckjobs zum Drucken gekommen sind
Do Until pdfjob.cCountOfPrintjobs = lTtlSheets
DoEvents
Loop
'Alle Seiten in ein PDF-Dokument zusammenfassen
With pdfjob
.cCombineAll
.cPrinterStop = False
End With
'Warten, bis PDFCreator gedruckt hat; dann Freigabe des Objekts
Do Until pdfjob.cCountOfPrintjobs = 0
DoEvents
Loop
pdfjob.cClose
Set pdfjob = Nothing
End Sub
Quelle: Ken Puls (www.excelguru.ca)

Mehr Tipps: Excel - Makros nach einer vorgegebenen Zeit starten

Sponsoren und Investoren

Sponsoren und Investoren sind jederzeit herzlich willkommen!
Wenn Sie die Information(en) auf dieser Seite interessant fanden, freuen wir uns über eine kleine Spende. Empfehlen Sie uns bitte auch in Ihren Netzwerken (z. B. Twitter, Facebook oder Google+). Herzlichen Dank!

Nach oben Sitemap
Impressum & Kontakt