1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67
| Set ClasseurTemp = ActiveWorkbook
sPDFName = Left(ClasseurTemp.Name, Len(ClasseurTemp.Name) - 4)
sPDFPath = ClasseurTemp.Path & Application.PathSeparator
Set PDFJob = CreateObject("PDFCreator.clsPDFCreator")
If PDFJob.cStart("/NoProcessingAtStartup") = False Then
MsgBox "Can not initialize PDFCreator.", vbCritical + vbOKOnly, "Error!"
Exit Sub
End If
With PDFJob
.cOption("UseAutosave") = 1
.cOption("UseAutosaveDirectory") = 1
.cOption("AutosaveDirectory") = sPDFPath
.cOption("AutosaveFilename") = sPDFName
.cOption("AutosaveFormat") = 0
'Pour une sécutité minimale
.cOption("PDFUseSecurity") = 1
.cOption("PDFOwnerPass") = 1
.cOption("PDFOwnerPasswordString") = sPswdPrincipal
'Options de sécurité
.cOption("PDFDisallowCopy") = 1
.cOption("PDFDisallowModifyContents") = 1
.cOption("PDFDisallowPrinting") = 0
'Pour forcer l'utilisateur à saisir un mot de passe
.cOption("PDFUserPass") = 1
.cOption("PDFUserPasswordString") = sPswdUtilsateur
'Cryptage élevé
.cOption("PDFHighEncryption") = 1
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 |
Partager