'=====================================================================================
'
' [url=http://sourceforge.net/projects/pdfcreator]SourceForge.net: PDFCreator[/url] PDFCreator-0_9_3_GPLGhostscript.exe
' sous VBA Menu Outils | Références Cocher PDFCreator
' Cocher Microsoft CDO for Exchange xxxx Library
'
'=====================================================================================
Option Explicit
Sub Tst_PdfCreator()
Dim objMessage As CDO.Message
Dim JobPDF As Object
Dim sNomPDF As String
Dim sCheminPDF As String
sNomPDF = "Essai_PdfCreator.pdf"
sCheminPDF = ActiveWorkbook.Path & Application.PathSeparator
If IsEmpty(ActiveSheet.UsedRange) Then Exit Sub
Set JobPDF = CreateObject("PDFCreator.clsPDFCreator")
With JobPDF
If .cStart("/NoProcessingAtStartup") = False Then
MsgBox "Initialisation de PDFCreator impossible", vbCritical + vbOKOnly, "PDFCreator"
Exit Sub
End If
.cOption("UseAutosave") = 1
.cOption("UseAutosaveDirectory") = 1
.cOption("AutosaveDirectory") = sCheminPDF
.cOption("AutosaveFilename") = sNomPDF
' 0=PDF, 1=Png, 2=jpg, 3=bmp, 4=pcx, 5=tif, 6=ps, 7=eps, 8=txt
.cOption("AutosaveFormat") = 0
.cClearCache
End With
ActiveSheet.PrintOut copies:=1, ActivePrinter:="PDFCreator"
'Fichier dans la file d'attente
Do Until JobPDF.cCountOfPrintjobs = 1
DoEvents
Loop
JobPDF.cPrinterStop = False
'Attendre que la file d'attente soit vide
Do Until JobPDF.cCountOfPrintjobs = 0
DoEvents
Loop
JobPDF.cClose
Set JobPDF = Nothing
Set objMessage = CreateObject("CDO.Message")
With objMessage
.Subject = "Example"
.From = "xxxxx@wanadoo.fr"
.To = "yyyyy@orange.fr"
.TextBody = "Texte dans le corps de message"
.AddAttachment sCheminPDF & sNomPDF
.Send
End With
Set objMessage = Nothing
End Sub