Example concret d'un script VBA pour imprimer et fusionner 2 fichiers PDF via Excel

Bonjour,

En installant la dernière version de PDFcreator j'ai consulté les exemples disponibles dans le répertoire d'installation.

Seulement, il n'y en a pas pour Excel.

Je cherche à imprimer en PDF 2 fichiers et à les fusionner.

J'ai lu la notice des nouvelles fonctions en ligne. Mais cela ne m'aide pas du tout.

Serait il possible d'avoir un exemple pour Excel?

Merci à vous.

Hi,

take a look at the macros contained in the following file:
C:\Program Files\PDFCreator\Com Scripts\Word - VBA\Testpage2PDF.docm

Hope this help,
Gianni

Hi,

The VBA with Word is different in Excel. I search an example with Excel only.

I tried to copy the code in C:\Program Files\PDFCreator\Com Scripts\Word - VBA\Testpage2PDF.docm inside a new Excel.xlsm file. But it did'nt worked.

Where can I find an example for Excel only?

Thank you.

Some instructions differ, like the following:

Application.ActivePrinter = "PDFCreator"
ActiveDocument.PrintOut Background:=False

but the rest is working the same.

I'm not a VBA expert so I cannot help you further, but on the web you should find some help.

Gianni

In the "Com Scripts" folder of the old version 1.7.3 there are these files:
frmPDFCreatorExcel.frm
frmPDFCreatorWord.frm

PDFCreator Version 1.7.3 is very different from the current version,
but the code to print Excel pages should be of help.

frmPDFCreatorExcel.frm

VERSION 5.00
Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} frmPDFCreator
Caption = "UserForm1"
ClientHeight = 4620
ClientLeft = 45
ClientTop = 435
ClientWidth = 7530
OleObjectBlob = "frmPDFCreatorExcel.frx":0000
ShowModal = 0 'False
StartUpPosition = 1 'Fenstermitte
End
Attribute VB_Name = "frmPDFCreator"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Declare Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As Long)

' Add a reference to PDFCreator
Private WithEvents PDFCreator1 As PDFCreator.clsPDFCreator
Attribute PDFCreator1.VB_VarHelpID = -1

Private ReadyState As Boolean, DefaultPrinter As String

Private Sub CommandButton1_Click()
Dim outName As String, i As Long
If InStr(1, ActiveWorkbook.Name, ".", vbTextCompare) > 1 Then
outName = Mid(ActiveWorkbook.Name, 1, InStr(1, ActiveWorkbook.Name, ".", vbTextCompare) - 1)
Else
outName = ActiveWorkbook.Name
End If
CommandButton1.Enabled = False
If OptionButton1.Value = True Then
With PDFCreator1
.cOption("UseAutosave") = 1
.cOption("UseAutosaveDirectory") = 1
.cOption("AutosaveDirectory") = ActiveWorkbook.Path
.cOption("AutosaveFilename") = outName
.cOption("AutosaveFormat") = 0 ' 0 = PDF
.cClearCache
End With
For i = 1 To Application.Sheets.Count
Application.Sheets(i).PrintOut Copies:=1, ActivePrinter:="PDFCreator"
Next i
Do Until PDFCreator1.cCountOfPrintjobs = Application.Sheets.Count
DoEvents
Sleep 1000
Loop
Sleep 1000
PDFCreator1.cCombineAll
Sleep 1000
PDFCreator1.cPrinterStop = False
End If
If OptionButton2.Value = True Then
With PDFCreator1
.cOption("UseAutosave") = 1
.cOption("UseAutosaveDirectory") = 1
.cOption("AutosaveDirectory") = ActiveWorkbook.Path
Debug.Print outName & "-" & ActiveSheet.Name
.cOption("AutosaveFilename") = outName & "-" & ActiveSheet.Name
.cOption("AutosaveFormat") = 0 ' 0 = PDF
.cClearCache
End With
ActiveSheet.PrintOut Copies:=1, ActivePrinter:="PDFCreator"
Do Until PDFCreator1.cCountOfPrintjobs = 1
DoEvents
Sleep 1000
Loop
Sleep 1000
PDFCreator1.cPrinterStop = False
End If
End Sub

Private Sub PrintPage(PageNumber As Integer)
Dim cPages As Long
cPages = Selection.Information(wdNumberOfPagesInDocument)
If PageNumber > cPages Then
MsgBox "This document has only " & cPages & " pages!", vbExclamation
End If
DoEvents
ActiveDocument.PrintOut Background:=False, Range:=wdPrintFromTo, From:=CStr(PageNumber), To:=CStr(PageNumber)
DoEvents
End Sub

Private Sub PDFCreator1_eError()
AddStatus "ERROR [" & PDFCreator1.cErrorDetail("Number") & "]: " & PDFCreator1.cErrorDetail("Description")
End Sub

Private Sub PDFCreator1_eReady()
AddStatus "File'" & PDFCreator1.cOutputFilename & "' was saved."
PDFCreator1.cPrinterStop = True
CommandButton1.Enabled = True
End Sub

Private Sub UserForm_Initialize()
If Len(ActiveWorkbook.Path) = 0 Then
MsgBox "Please save the document first!", vbExclamation
End
End If
Set PDFCreator1 = New clsPDFCreator
With PDFCreator1
If .cStart("/NoProcessingAtStartup") = False Then
CommandButton1.Enabled = False
AddStatus "Can't initialize PDFCreator."
Exit Sub
End If
End With
AddStatus "PDFCreator initialized."
End Sub

Private Sub AddStatus(Str1 As String)
With TextBox1
If Len(.Text) = 0 Then
.Text = Now & ": " & Str1
Else
.Text = .Text & vbCrLf & Now & ": " & Str1
End If
.SelStart = Len(.Text)
.SetFocus
End With
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
PDFCreator1.cClose
Set PDFCreator1 = Nothing
Sleep 250
DoEvents
End Sub

frmPDFCreatorWord.frm

VERSION 5.00
Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} frmPDFCreator
Caption = "UserForm1"
ClientHeight = 4620
ClientLeft = 45
ClientTop = 435
ClientWidth = 7530
OleObjectBlob = "frmPDFCreatorWord.frx":0000
ShowModal = 0 'False
StartUpPosition = 1 'Fenstermitte
End
Attribute VB_Name = "frmPDFCreator"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Declare Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As Long)

' Add a reference to PDFCreator
Private WithEvents PDFCreator1 As PDFCreator.clsPDFCreator
Attribute PDFCreator1.VB_VarHelpID = -1

Private ReadyState As Boolean, DefaultPrinter As String

Private Sub CommandButton1_Click()
Dim outName As String
If InStr(1, ActiveDocument.Name, ".", vbTextCompare) > 1 Then
outName = Mid(ActiveDocument.Name, 1, InStr(1, ActiveDocument.Name, ".", vbTextCompare) - 1)
Else
outName = ActiveDocument.Name
End If
CommandButton1.Enabled = False
If OptionButton1.Value = True Then
SaveWholeDocumentAsPDF outName
End If
If OptionButton2.Value = True Then
With PDFCreator1
.cOption("UseAutosave") = 1
.cOption("UseAutosaveDirectory") = 1
.cOption("AutosaveDirectory") = ActiveDocument.Path
.cOption("AutosaveFilename") = outName & "-1_3"
.cOption("AutosaveFormat") = 0 ' 0 = PDF
.cClearCache
End With
PrintPage 1
Sleep 1000
PrintPage 3
Sleep 1000
PDFCreator1.cCombineAll
Sleep 1000
PDFCreator1.cPrinterStop = False
End If
End Sub

Private Sub SaveWholeDocumentAsPDF(Filename As String)
AddStatus "Start ..."
With PDFCreator1
.cOption("UseAutosave") = 1
.cOption("UseAutosaveDirectory") = 1
.cOption("AutosaveDirectory") = ActiveDocument.Path
.cOption("AutosaveFilename") = Filename
.cOption("AutosaveFormat") = 0 ' 0 = PDF
.cClearCache
DoEvents
ActiveDocument.PrintOut Background:=False
DoEvents
.cPrinterStop = False
End With
End Sub

Private Sub PrintPage(PageNumber As Integer)
Dim cPages As Long
cPages = Selection.Information(wdNumberOfPagesInDocument)
If PageNumber > cPages Then
MsgBox "This document has only " & cPages & " pages!", vbExclamation
End If
DoEvents
ActiveDocument.PrintOut Background:=False, Range:=wdPrintFromTo, From:=CStr(PageNumber), To:=CStr(PageNumber)
DoEvents
End Sub

Private Sub PDFCreator1_eError()
AddStatus "ERROR [" & PDFCreator1.cErrorDetail("Number") & "]: " & PDFCreator1.cErrorDetail("Description")
End Sub

Private Sub PDFCreator1_eReady()
AddStatus "File'" & PDFCreator1.cOutputFilename & "' was saved."
PDFCreator1.cPrinterStop = True
CommandButton1.Enabled = True
End Sub

Private Sub UserForm_Initialize()
If Len(ActiveDocument.Path) = 0 Then
MsgBox "Please save the document first!", vbExclamation
End
End If
Set PDFCreator1 = New clsPDFCreator
With PDFCreator1
If .cStart("/NoProcessingAtStartup") = False Then
CommandButton1.Enabled = False
AddStatus "Can't initialize PDFCreator."
Exit Sub
End If
DefaultPrinter = ActivePrinter
SetPrinter "PDFCreator"
End With
AddStatus "PDFCreator initialized."
End Sub

Private Sub AddStatus(Str1 As String)
With TextBox1
If Len(.Text) = 0 Then
.Text = Now & ": " & Str1
Else
.Text = .Text & vbCrLf & Now & ": " & Str1
End If
.SelStart = Len(.Text)
.SetFocus
End With
End Sub

Private Sub SetPrinter(Printername As String)
With Dialogs(wdDialogFilePrintSetup)
.Printer = Printername
.DoNotSetAsSysDefault = True
.Execute
End With
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
SetPrinter DefaultPrinter
PDFCreator1.cClose
Set PDFCreator1 = Nothing
Sleep 250
DoEvents
End Sub

Gianni

Comment out the following lines using ' (many occurrences through the code):

Application.ActivePrinter = "PDFCreator"
ActiveDocument.PrintOut Background:=False

In place of the second line insert this:

Application.Sheets(1).PrintOut Copies:=1, ActivePrinter:="PDFCreator"

HTH,
Gianni

I was also facing the same problem, thanks for this solution