Ben Becker
XLDnaute Nouveau
Bonjour à tous,
avec l'aide du forum, j'avais récupéré un code VBA pour convertir une feuille Excel en pdf puis l'envoyer par mail. Ce code fonctionne très bien, mais il ne marche que pour l'envoi d'une feuille du classeur. Je voudrais appliquer ce code pour plusieurs feuilles du classeur (ne générant qu'un seul fichier pdf) : ayant 13 feuilles dans mon classeur, je voudrais envoyer de la feuille 2 à la feuille 13.
Je sèche un peu, donc si vous avez une idée je suis preneur.
Merci d'avance pour votre aide.
Vous trouverez ci-dessous le code actuel.
Ben
Option Explicit
Sub Suivi_prono()
Dim objMessage As CDO.Message
Dim JobPDF As Object
Dim sNomPDF As String
Dim sCheminPDF As String
sNomPDF = "Suivi prono _ " & [AC1].Value & ".pdf"
sCheminPDF = "D:\documents\"
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 = "Suivi prono _ " & [AC1].Value
.From = "xxx@hotmail.fr"
.To = "zzz@hotmail.fr"
.TextBody = "Bonjour, la nouvelle fiche du " & [AC1].Value & " est arrivée. Bise"
.AddAttachment sCheminPDF & sNomPDF
.Send
End With
Set objMessage = Nothing
End Sub
Sub SuppProcPDFCreator()
Dim RetVal As Variant
RetVal = Shell("Taskkill /IM PDFCreator.exe /F", 0)
End Sub
ps : AC1 reprend la date du jour et cela sur toutes les feuilles
avec l'aide du forum, j'avais récupéré un code VBA pour convertir une feuille Excel en pdf puis l'envoyer par mail. Ce code fonctionne très bien, mais il ne marche que pour l'envoi d'une feuille du classeur. Je voudrais appliquer ce code pour plusieurs feuilles du classeur (ne générant qu'un seul fichier pdf) : ayant 13 feuilles dans mon classeur, je voudrais envoyer de la feuille 2 à la feuille 13.
Je sèche un peu, donc si vous avez une idée je suis preneur.
Merci d'avance pour votre aide.
Vous trouverez ci-dessous le code actuel.
Ben
Option Explicit
Sub Suivi_prono()
Dim objMessage As CDO.Message
Dim JobPDF As Object
Dim sNomPDF As String
Dim sCheminPDF As String
sNomPDF = "Suivi prono _ " & [AC1].Value & ".pdf"
sCheminPDF = "D:\documents\"
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 = "Suivi prono _ " & [AC1].Value
.From = "xxx@hotmail.fr"
.To = "zzz@hotmail.fr"
.TextBody = "Bonjour, la nouvelle fiche du " & [AC1].Value & " est arrivée. Bise"
.AddAttachment sCheminPDF & sNomPDF
.Send
End With
Set objMessage = Nothing
End Sub
Sub SuppProcPDFCreator()
Dim RetVal As Variant
RetVal = Shell("Taskkill /IM PDFCreator.exe /F", 0)
End Sub
ps : AC1 reprend la date du jour et cela sur toutes les feuilles