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 68 69 70 71 72 73 74 75 76 77 78 79
| Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Const maxTime = 10 ' en secondes
Private Const sleepTime = 250 ' en millisecondes
Public Sub SaveAsPDF(Optional ByVal strPDFName As String = "", _
Optional ByVal strDirectory As String = "")
Dim pdfc As PDFCreator.clsPDFCreator
Dim DefaultPrinter As String
Dim c As Long
Dim OutputFilename As String
prodErreur = False
MsgBox nomfichier
strPDFName = nomfichier
' Instancier un nouvel objet PDFCreator
Set pdfc = New clsPDFCreator
' Paramétrer l'objet PDFCreator
With pdfc
.cStart "/NoProcessingAtStartup"
.cOption("UseAutosave") = 1
.cOption("UseAutosaveDirectory") = 1
' Chemin de destination
' Par défaut : dossier 'Mes documents' de l'utilisateur
strDirectory = repert
Debug.Print strPDFName
If strDirectory = "" Then
strDirectory = Environ("USERPROFILE") & "\Mes documents\"
End If
.cOption("AutosaveDirectory") = strDirectory
' Nom du fichier PDF à générer
.cOption("AutosaveFilename") = _
IIf(strPDFName = "", ActiveWorkbook.Name, strPDFName)
Call a_supprimer
' Format de sauvegarde (0 = PDF)
.cOption("AutosaveFormat") = 0
' Mémoriser l'imprimante par défaut
' et définir PDFCreator à la place
DefaultPrinter = .cDefaultPrinter
.cDefaultPrinter = "PDFCreator"
.cClearCache
'Imprimer les feuilles sélectionnées
ActiveSheet.PrintOut Copies:=1, ActivePrinter:="PDFCreator", Collate:=True ', PrintToFile:=True
Do Until pdfc.cCountOfPrintjobs = 0
DoEvents
Loop
' Do Until .cCountOfPrintjobs = 1 ' Attend la Fin du travail pour quitter
'DoEvents
'Sleep 1000
'Loop
'Sleep 1000
.cPrinterStop = False
End With
' Temporisation
c = 0
Do While (pdfc.cOutputFilename = "") And (c < 50)
c = c + 1
Sleep 200
Loop
' Nom du fichier PDF produit
OutputFilename = pdfc.cOutputFilename
' Réinstaller l'imprimante d'origine
With pdfc
.cDefaultPrinter = DefaultPrinter
Sleep 200
.cClose
End With
' Attendre jusqu'à ce que PDFCreator soit supprimé de la mémoire
Sleep 2000
' Vérifier si le fichier a été créé
If OutputFilename = "" Then
MsgBox "Création du fichier PDF." & vbCrLf & vbCrLf & _
"Une erreur s'est produite : temps écoulé !", vbExclamation + vbSystemModal
prodErreur = True
End If
End Sub |
Partager