Bon je sais le code n'est pas très propre mais dès que j'ai la version final, je la fait suivre !
- Code : Tout sélectionner
On Error Goto ErrorHandler
Dim sDefaultPrinter As String, spdfname As String
Dim ws As New notesuiworkspace()
Dim vrPDFCreator As Variant, PrtNamesColl As Variant
Dim doc As notesdocument
Dim cStartedFlag As Boolean, PrinterReset As Boolean
Dim UIDocToPrint As NotesUIDocument, uidoc As NotesUIDocument
Dim PDFCreatorOptions As Variant ' PDFCreator options to restore.
Set uidoc = ws.currentdocument
set doc = uidoc.Document()
Call uidoc.Save()
uidoc.EditMode=False
Dim RTIForAttachment As NotesRichTextItem
Set RTIForAttachment = doc.GetFirstItem("FilePDF")
If Not Isempty(RTIForAttachment.EmbeddedObjects) Then
Msgbox "Il y a déjà un PDF rattaché au document. Fin du programme."
Exit Sub
End If
REM Récupère l'imprimante par défaut
sDefaultPrinter = PrinterDefautGet()
REM Objet qui gère l'impression
Set vrPDFCreator = CreateObject("PDFCreator.clsPDFCreator")
Set PrtNamesColl = vrPDFCreator.cGetPDFCreatorPrinters()
If vrPDFCreator.cProgramIsRunning Then
cStartedFlag = True
Else
cStartedFlag = vrPDFCreator.cStart( , True)
End If
If cStartedFlag = False Then
Msgbox("CreatePDF - PDFCreator failed to start or not installed. Process halted.")
Goto skip
End If
' Grab the current options for restoration later.
Set PDFCreatorOptions = vrPDFCreator.cOptions
With vrPDFCreator
REM Passe L'imprimante PDFCreator en imprimante par défaut
.cDefaultprinter = Cstr(PrtNamesColl.Item(1))
REM Set and save the PDFCreator options.
.cClearCache
.cOption("UseAutosave") = 1
.cOption("UseAutosaveDirectory") = 1
.cOption("AutosaveDirectory") = Environ("Temp")
.cOption("AutosaveFilename") = Cstr(doc.UniversalID())
.cOption("AutosaveFormat") = 0
.cOption("AutosaveStartStandardProgram" ) = 0
.cOption("NoConfirmMessageSwitchingDefaultprinter") = 0
End With
Call vrPDFCreator.cSaveOptions()
Set UIDocToPrint = app.ws.EditDocument(False, Doc, True , "" , True , True)
Call UIDocToPrint.Print(1 , , , , PrtNamesColl.Item(1))
Call UIDocToPrint.Close(True)
spdfname = Environ("Temp") +"\"+ Cstr(doc.UniversalID()) + ".pdf"
REM Wait for print job to complete.
Dim counter As Integer
Counter = 0
Do Until (vrPDFCreator.cCountOfPrintJobs = 0 And Dir(spdfname) <> "" ) Or Counter = 30
Yield
Sleep 1
Yield
Counter = Counter + 1
Loop
If Counter = 30 Then
Msgbox ("CreatePDF - PDF Conversion never completed. Process halted.")
Goto skip
End If
skip:
With vrPDFCreator
REM Blocage de l'imprimante
.cPrinterStop = True
REM remet l'imprimante par défaut d'origine
.cDefaultprinter = sDefaultPrinter
REM Vide le Cache de PDFCreator
.cClearCache
End With
REM Restore and save original options, then close PDFCreator only if it had been started by this sub.
Set vrPDFCreator.cOptions = PDFCreatorOptions
REM Ferme l'application PDFCreator
Call vrPDFCreator.cSaveOptions()
Call vrPDFCreator.cClose
Call RTIForAttachment.EmbedObject (EMBED_ATTACHMENT , "" , spdfname)
Kill spdfname
Call doc.Save(True, False)
Call uidoc.Close(True)
Call ws.EditDocument(True, doc)
Exit Sub
ErrorHandler:
If Datatype(vrPDFCreator) <> 0 Then
If Err = 4412 Then
Call UIDoc.Close( True )
Sleep 3
End If
Call vrPDFCreator.cErrorClear()
If PrinterReset And sDefaultPrinter <> Cstr( PrtNamesColl.Item(1)) Then
vrPDFCreator.cDefaultPrinter = Cstr( PrtNamesColl.Item(1))
vrPDFCreator.cDefaultPrinter = sDefaultPrinter
End If
Set vrPDFCreator.cOptions = PDFCreatorOptions
Call vrPDFCreator.cSaveOptions()
Call vrPDFCreator.cClose()
Else
Msgbox "PDFCreator pas installé. Veuillez contacter votre répondant informatique."
Exit Sub
End If
End Sub
