Sub Excel2PDF()
Dim objPDF As Object 'As PDFCreator.clsPDFCreator
Dim S As Worksheet
Dim R As Range
Dim OBJ As Object
Dim rep&
Dim ImprimanteActive$
Dim Message$
ImprimanteActive$ = Application.ActivePrinter
Application.ScreenUpdating = False
If TypeName(Selection) = "Range" Then
Set R = Selection
rep& = MsgBox(prompt:="La plage " & R.Address(False, False) & " va être imprimée en PDF" & _
vbCrLf & vbCrLf & "Voulez-vous continuer ?", Buttons:=vbOKCancel + vbDefaultButton2)
If rep& = vbCancel Then
Application.ScreenUpdating = True
Exit Sub
End If
Else
On Error Resume Next
For Each OBJ In Selection
Message$ = Message$ & vbCrLf & OBJ.Name
Next
Err.Clear
On Error GoTo 0
rep& = MsgBox(prompt:="Les objets suivants vont être imprimés en PDF" & vbCrLf & Message$ & _
vbCrLf & vbCrLf & "Voulez-vous continuer ?", Buttons:=vbOKCancel + vbDefaultButton2)
If rep& = vbCancel Then
Application.ScreenUpdating = True
Exit Sub
End If
Selection.Copy
Set S = Sheets.Add
S.Paste
End If
Set objPDF = CreateObject("PDFCreator.clsPDFCreator")
With objPDF
If .cstart("/NoProcessingAtStartup") = False Then
MsgBox prompt:="On ne peut pas lancer PDFCreator", _
Buttons:=vbInformation + vbOKOnly
Exit Sub
End If
.cOption("UseAutosave") = 1
.cOption("UseAutosaveDirectory") = 1
.cOption("AutosaveDirectory") = ThisWorkbook.Path
.cOption("AutosaveFilename") = "MonPDF.pdf"
.cOption("AutosaveFormat") = 0
.cClearCache
End With
If TypeName(Selection) = "Range" Then
R.PrintOut copies:=1, ActivePrinter:="PDFCreator"
Else
S.PrintOut copies:=1, ActivePrinter:="PDFCreator"
Application.DisplayAlerts = False
S.Delete
Set S = Nothing
Application.DisplayAlerts = True
End If
Do Until objPDF.cCountOfPrintjobs = 1
DoEvents
Loop
objPDF.cPrinterStop = False
Do Until objPDF.cCountOfPrintjobs = 0
DoEvents
Loop
With objPDF
.cDefaultprinter = "PDFCreator"
.cClearCache
.cClose
End With
Set objPDF = Nothing
Application.ActivePrinter = ImprimanteActive$
Application.ScreenUpdating = True
End Sub