Le 27/02/2014 05:10, (e-mail address removed) a écrit :
Hello NG
I have an Excel macro, that creates a number single Word-documents (not mail merge),
based on data from en Excel spreadsheet, using bookmarks in the Word document.
I want to save the documents as PDF files.
Hello
Printing to a Pdf file is different than to a Word file.
Have a look at
www.excelguru.ca
Regards
J@@
tested successfully using PDFCreator 0.9.1, GPLGhostscript.exe download package.
Excel versions tested include:
1. Excel 2003
2. Excel 2007
'**********************Print a Single Worksheet to a PDF File:
Option Explicit
Sub PrintToPDF_Late()
'Author : Ken Puls (
www.excelguru.ca)
'Macro Purpose: Print to PDF file using PDFCreator
' (Download from
http://sourceforge.net/projects/pdfcreator/)
' Designed for late bind, no references req'd
Dim pdfjob As Object
Dim sPDFName As String
Dim sPDFPath As String
'/// Change the output file name here! ///
sPDFName = "testPDF.pdf"
sPDFPath = ActiveWorkbook.Path & Application.PathSeparator
'Check if worksheet is empty and exit if so
If IsEmpty(ActiveSheet.UsedRange) Then Exit Sub
Set pdfjob = CreateObject("PDFCreator.clsPDFCreator")
With pdfjob
If .cStart("/NoProcessingAtStartup") = False Then
MsgBox "Can't initialize PDFCreator.", vbCritical + _
vbOKOnly, "PrtPDFCreator"
Exit Sub
End If
.cOption("UseAutosave") = 1
.cOption("UseAutosaveDirectory") = 1
.cOption("AutosaveDirectory") = sPDFPath
.cOption("AutosaveFilename") = sPDFName
.cOption("AutosaveFormat") = 0 ' 0 = PDF
.cClearCache
End With
'Print the document to PDF
ActiveSheet.PrintOut copies:=1, ActivePrinter:="PDFCreator"
'Wait until the print job has entered the print queue
Do Until pdfjob.cCountOfPrintjobs = 1
DoEvents
Loop
pdfjob.cPrinterStop = False
'Wait until PDF creator is finished then release the objects
Do Until pdfjob.cCountOfPrintjobs = 0
DoEvents
Loop
pdfjob.cClose
Set pdfjob = Nothing
End Sub
'*******************Print Multiple Worksheets to Multiple PDF Files:
Option Explicit
Sub PrintToPDF_MultiSheet_Late()
'Author : Ken Puls (
www.excelguru.ca)
'Macro Purpose: Print to PDF file using PDFCreator
' (Download from
http://sourceforge.net/projects/pdfcreator/)
' Designed for late bind, no references req'd
Dim pdfjob As Object
Dim sPDFName As String
Dim sPDFPath As String
Dim lSheet As Long
Set pdfjob = CreateObject("PDFCreator.clsPDFCreator")
sPDFPath = ActiveWorkbook.Path & Application.PathSeparator
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
'Check if worksheet is empty and skip if so
If Not IsEmpty(ActiveSheet.UsedRange) Then
With pdfjob
'/// Change the output file name here! ///
sPDFName = "testPDF" & Sheets(lSheet).Name & ".pdf"
.cOption("UseAutosave") = 1
.cOption("UseAutosaveDirectory") = 1
.cOption("AutosaveDirectory") = sPDFPath
.cOption("AutosaveFilename") = sPDFName
.cOption("AutosaveFormat") = 0 ' 0 = PDF
.cClearCache
End With
'Print the document to PDF
Worksheets(lSheet).PrintOut copies:=1, ActivePrinter:="?PDFCreator"?
'Wait until the print job has entered the print queue
Do Until pdfjob.cCountOfPrintjobs = 1
DoEvents
Loop
pdfjob.cPrinterStop = False
'Wait until PDF creator is finished then release the objects
Do Until pdfjob.cCountOfPrintjobs = 0
DoEvents
Loop
End If
Next lSheet
pdfjob.cClose
Set pdfjob = Nothing
End Sub
'**************Print Multiple Worksheets to a Single PDF File:
Option Explicit
Sub PrintToPDF_MultiSheetToOne_Late()
'Author : Ken Puls (
www.excelguru.ca)
'Macro Purpose: Print to PDF file using PDFCreator
' (Download from
http://sourceforge.net/projects/pdfcreator/)
' Designed for late bind, no references req'd
Dim pdfjob As Object
Dim sPDFName As String
Dim sPDFPath As String
Dim lSheet As Long
Dim lTtlSheets As Long
'/// Change the output file name here! ///
sPDFName = "Consolidated.pdf"
sPDFPath = ActiveWorkbook.Path & Application.PathSeparator
Set pdfjob = CreateObject("PDFCreator.clsPDFCreator")
'Make sure the PDF printer can start
If pdfjob.cStart("/NoProcessingAtStartup") = False Then
MsgBox "Can't initialize PDFCreator.", vbCritical + _
vbOKOnly, "Error!"
Exit Sub
End If
'Set all defaults
With pdfjob
.cOption("UseAutosave") = 1
.cOption("UseAutosaveDirectory") = 1
.cOption("AutosaveDirectory") = sPDFPath
.cOption("AutosaveFilename") = sPDFName
.cOption("AutosaveFormat") = 0 ' 0 = PDF
.cClearCache
End With
'Print the document to PDF
lTtlSheets = Application.Sheets.Count
For lSheet = 1 To Application.Sheets.Count
On Error Resume Next 'To deal with chart sheets
If Not IsEmpty(Application.Sheets(lSheet).UsedRange) Then
Application.Sheets(lSheet).PrintOut copies:=1, ActivePrinter:="PDFCreator"
Else
lTtlSheets = lTtlSheets - 1
End If
On Error GoTo 0
Next lSheet
'Wait until all print jobs have entered the print queue
Do Until pdfjob.cCountOfPrintjobs = lTtlSheets
DoEvents
Loop
'Combine all PDFs into a single file and stop the printer
With pdfjob
.cCombineAll
.cPrinterStop = False
End With
'Wait until PDF creator is finished then release the objects
Do Until pdfjob.cCountOfPrintjobs = 0
DoEvents
Loop
pdfjob.cClose
Set pdfjob = Nothing
End Sub
'*********************
Sub ImprimEn1PDF_SelectFeuils()
'Author : Ken Puls (
www.excelguru.ca)
'mod. pour sélection de feuilles J@@ conseils DanielCo
'Macro Purpose: Print to PDF file using **PDFCreator**
' (Download from
http://sourceforge.net/projects/pdfcreator/)
' Designed for late bind, no references req'd
Dim PdfJob As Object
Dim SpdFname As String
Dim SpdFpath As String
Dim lSheet As Long
Dim lTtlSheets As Long
Dim sh As Worksheet
'/// Change the output file name here! ///
SpdFname = "Consolidated.pdf"
SpdFpath = ActiveWorkbook.Path & Application.PathSeparator
Set PdfJob = CreateObject("PDFCreator.clsPDFCreator")
'Make sure the PDF printer can start
If PdfJob.cstart("/NoProcessingAtStartup") = False Then
MsgBox "Imposssible d'initialiser PDFCreator.", vbCritical + _
vbOKOnly, "Erreur!"
Exit Sub
End If
'Set all defaults
With PdfJob
.cOption("UseAutosave") = 1
.cOption("UseAutosaveDirectory") = 1
.cOption("AutosaveDirectory") = SpdFpath
.cOption("AutosaveFilename") = SpdFname
.cOption("AutosaveFormat") = 0 ' 0 = PDF
.cClearCache
End With
'Imprimer les feuilles sélectionnées
lTtlSheets = ActiveWorkbook.Windows(1).SelectedSheets.Count
For Each sh In ActiveWorkbook.Windows(1).SelectedSheets
On Error Resume Next 'To deal with chart sheets
If Not IsEmpty(sh.UsedRange) Then
sh.PrintOut copies:=1, ActivePrinter:="PDFCreator"
End If
On Error GoTo 0
Next sh
'Wait until all print jobs have entered the print queue
Do Until PdfJob.ccountofprintjobs = lTtlSheets
DoEvents
Loop
'Combine all PDFs into a single file and stop the printer
With PdfJob
.ccombineall
.cPrinterStop = False
End With
'Wait until PDF creator is finished then release the objects
Do Until PdfJob.ccountofprintjobs = 0
DoEvents
Loop
PdfJob.cClose
Set PdfJob = Nothing
End Sub
'***************
