Re : répéter un bout de macro sous excel
Bonjour à tous,
voici ma dernière macro (en fait j'ai été obligé d'en créer 2, car je fait à peu près la même chose sur une autre feuille).
Dites-moi si vous trouvez ça pas beau
Option Explicit
Sub Tst_PdfCreator()
Dim JobPDF As Object
Dim sNomPDF As String
Dim sCheminPDF As String
Dim K As Variant
Dim flux As Variant
Sheets("Synthèse").Activate
For Each K In Range("D1
43")
flux = K.Text
ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotFields("Regroupement" _
).CurrentPage = flux
sNomPDF = "Synthèse " & ActiveSheet.Range("A3") & "_" & Range("A2") & ".pdf"
sCheminPDF = ThisWorkbook.Path & "\ger 18102012\"
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
.cOption("AutosaveStartStandardProgram") = 0
.cOption("UpdateInterval") = 0
' 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
Next K
End Sub
Sub Tst_PdfCreator2()
Dim JobPDF As Object
Dim sNomPDF As String
Dim sCheminPDF As String
Dim K As Variant
Dim flux As Variant
Sheets("Détails").Activate
For Each K In Range("G1:G43")
flux = K.Text
Sheets("Détails").Activate
ActiveSheet.PivotTables("Tableau croisé dynamique2").PivotFields("Regroupement" _
).CurrentPage = flux
sNomPDF = "Détails " & ActiveSheet.Range("A3") & "_" & Range("A2") & ".pdf"
sCheminPDF = ThisWorkbook.Path & "\ger 18102012\"
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
.cOption("AutosaveStartStandardProgram") = 0
.cOption("UpdateInterval") = 0
' 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
Next K
End Sub