- Code : Tout sélectionner
Public Function PDFCreator(wPathFileSource As String,wPathCible As String,wFileCible As String) As Integer
'utilise la versin 0.9.1 de PDFCreator
'wPathFileSource = fichier a transformer en pdf
'wFileCible = nom fichier pdf a générer
'wpathCible = chemin du fichier pdf a générer
'Déclaration Variable
Dim vrPDFCreator As Variant
' Dim vrPDFCreatorError As Variant
Dim vrPDFCreatorOptions As Variant
Dim DefaultPrinter As String
Dim PathCible As String
Dim FileCible As String
Dim PathFileCible As String
Dim i As Integer
Dim nbMaxSleep As Integer
Dim nbOk As Integer
On Error Goto ErreurHandle
PDFCreator = False
'nombre maximal de tentative de détection du fichier PDF a générer
nbMaxSleep = 15
If Trim(wPathFileSource) = "" Then
Error 9999, "wPathFileSource is empty"
Exit Function
Elseif isValideFile(Trim(wPathFileSource)) = False Then
Error 9999, "wPathFileSource Not Found : "+wPathFileSource
Exit Function
End If
If Trim(wFileCible) = "" Then
Error 9999, "wFileCible is empty"
Exit Function
End If
If Trim(wPathCible) = "" Then
Error 9999, "PathCible is empty"
Exit Function
Else
If Right(Trim(wPathCible),1) = "\" Then
PathCible = Trim(wPathCible)
Else
PathCible = Trim(wPathCible)+"\"
End If
If isValideDirectory(Trim(PathCible)) = False Then
Error 9999, "PathCible Not Found : "+Trim(PathCible)
Exit Function
End If
End If
FileCible = wFileCible
PathFileCible = PathCible+FileCible
'Objet qui gère l'impression
Set vrPDFCreator = CreateObject( "PDFCreator.clsPDFCreator" )
'Objet qui gère les erreurs
' Set vrPDFCreatorError = CreateObject( "PDFCreator.clsPDFCreatorError" )
vrPDFCreator.cStart("/NoProcessingAtStartup")
'Test si le fichier source est imprimable (transformable en PDF)
If vrPDFCreator.cIsPrintable(wPathFileSource) = False Then
vrPDFCreator.cClearCache
vrPDFCreator.cClose
Set vrPDFCreator = Nothing
Set vrPDFCreatorOptions = Nothing
' Set vrPDFCreatorError = Nothing
PathFileCible = ""
PathCible = ""
FileCible = ""
Error 9999,"PDFCreator No Printable file : "+wPathFileSource
Exit Function
End If
'Objet qui gère les Options de création des PDF
Set vrPDFCreatorOptions = CreateObject( "PDFCreator.clsPDFCreatorOptions" )
'récupère l'imprimante par défaut
'DefaultPrinter = Cstr(vrPDFCreator.cDefaultprinter)
'vide le cache de PDFCreator
vrPDFCreator.cClearCache
'Passe L'imprimante PDFCréator en imprimante par défaut
vrPDFCreator.cDefaultprinter = "PDFCreator"
vrPDFCreator.cOption("UseAutosave") = 1
vrPDFCreator.cOption("UseAutosaveDirectory") = 1
'Répertoire cible du PDF as Générer
vrPDFCreator.cOption("AutosaveDirectory") = PathCible
'Nom du PDf à générer
vrPDFCreator.cOption("AutosaveFilename") = FileCible
vrPDFCreator.cOption("AutosaveFormat") = 0 ' 0 = PDF
'Gestion du copié/collé dans le pdf
vrPDFCreatorOptions.Pdfdisallowcopy = False
'gestion des annotations
vrPDFCreatorOptions.Pdfdisallowmodifyannotations = True
'Gestion des Commentaires
vrPDFCreatorOptions.Pdfdisallowmodifycontents = True
PathCible = ""
FileCible = ""
'lance la génération du PDF
vrPDFCreator.cPrintfile(wPathFileSource)
'annule le blocage de l'imprimante
vrPDFCreator.cPrinterStop = False
'test si le fichier PDF est créé
PDFCreator = isValideFile(PathFileCible)
'Boucle sur le fichier PDF pour tester s'il est créé
If PDFCreator = False Then
nbOk = False
While nbOk = False
If i> nbMaxSleep Then
'pour eviter les boucles infini
nbOk = True
Else
'attent 1 seconde
Sleep 1
i=i+1
PDFCreator = isValideFile(PathFileCible)
nbOk = PDFCreator
End If
Wend
End If
'Blocage de l'imprimante
vrPDFCreator.cPrinterStop = True
'remet l'imprimante par défaut d'origine
'vrPDFCreator.cDefaultprinter = DefaultPrinter
'Vide le Cache de PDFCreator
vrPDFCreator.cClearCache
'ferm l'application PDFCreator
vrPDFCreator.cClose
Set vrPDFCreator = Nothing
Set vrPDFCreatorOptions = Nothing
'Set vrPDFCreatorError = Nothing
DefaultPrinter = ""
PathFileCible = ""
Exit Function
ErreurHandle:
Msgbox "("+Cstr(Getthreadinfo (1))+")"+Chr(10)+"Erreur " + Str(Err) + " : "+Chr(10) + Cstr(Error)+". "+Chr(10)+"Ligne N° "+Cstr(Erl),16," ERREUR !"
PDFCreator = False
Exit Function
End Function
la fonction isValideFile est disponible ici => http://forum.dominoarea.org/tester-lexi ... 12374.html
la fonction isValideDirectory est disponible ici => http://forum.dominoarea.org/tester-lexi ... 12375.html
