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
| Option Compare Database
Option Explicit
Private Declare Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As Long)
Public Sub ImprimePDF(ReportName As String, PDFName As String, PDFLocation As String)
Dim PDFCreator1 As PDFCreator.clsPDFCreator ' Objet PDF
Dim DefaultPrinter As String ' Imprimante par Défaut (mémorisation)
Dim c As Long ' Compteur Temporisation
Dim OutputFilename As String ' Nom du Fichier Généré
Set PDFCreator1 = New clsPDFCreator
With PDFCreator1
.cStart "/NoProcessingAtStartup"
.cOption("UseAutosave") = 1
.cOption("UseAutosaveDirectory") = 1
.cOption("AutosaveDirectory") = PDFLocation ' Répertoire de stockage du Fichier PDF généré
.cOption("AutosaveFilename") = PDFName ' Nom du Fichier PDF à produire (Remplace
' par des _ les caractères interdits
.cOption("AutosaveFormat") = 0 ' 0 = PDF
DefaultPrinter = .cDefaultPrinter ' Mémorise l'Imprimante pas défaut
.cDefaultPrinter = "PDFCreator" ' écrasé par PDFCreator
.cClearCache
End With
DoCmd.OpenReport ReportName, acViewPreview ' Ouvre l'état en mode Aperçu
DoCmd.PrintOut acPrintAll, , , acDraft ' Imprime l'état avec l'option brouillon acDraft
DoCmd.Close acReport, ReportName ' (à changer selon les résultats attendus)
Do Until PDFCreator1.cCountOfPrintjobs = 1 ' Attend la Fin du travail pour quitter
DoEvents
Sleep 1000
Loop
Sleep 1000
PDFCreator1.cPrinterStop = False
c = 0 ' Attend la Fin d'Ecriture
Do While (PDFCreator1.cOutputFilename = "") And (c < 50) ' au besoin 50x200ms (1 sec)
c = c + 1
Sleep 200
Loop
OutputFilename = PDFCreator1.cOutputFilename ' Récupère le nom du Fichier Généré
With PDFCreator1
.cDefaultPrinter = DefaultPrinter ' Réattribue l'Imprimante initiale
Sleep 200 ' Tempo de prise en compte avant fermeture
.cClose
End With
Sleep 2000 ' Tempo 2 sec permettant d'assurer la libération de PDFCreator de la Mémoire
If OutputFilename = "" Then
MsgBox "Création Fichier pdf." & vbCrLf & vbCrLf & _
"Une Erreur s'est produite: Délai dépassé!", vbExclamation + vbSystemModal
End If
' Suppression des objets et des tâches créées
Set PDFCreator1 = Nothing
Shell "taskkill /f /im PDFCreator.exe", vbHide
End Sub |
Partager