répéter un bout de macro sous excel

loootoo02

XLDnaute Nouveau
Bonjour à tous,

je viens vers vous, car j'ai des difficultés à réduire une macro que je viens de créer. En me baladant sur plusieurs forum, j'ai vu que l'on pouvait faire des boucles, mais je n'y arrive pas.

Je vais vous expliquer mon problème, et excusez d'avance mon langage qui n'est pas au top, je suis novice en VBA:

J'ai un gros tableau d'environ 18 000 ligne, sur lequel j'ai fait 2 tableaux croisés dynamique, afin d'avoir des synthèse associé à chaque client.
J'ai tout d'abord créé une macro pour convertir ma feuille avec mon tableau croisé en format PDF avec un nom de fichier qui évolu en fonction d'une sélection dans un menu déroulant de ce même tableau croisé.

Jusque ici, ça marche. Mais mon problème est que je fait répéter mon bout de macro à chaque fois que je change ma sélection. (pour changer ma sélection, j'utilise la fonction (ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotFields("Regroupement" _).CurrentPage = "Flux XXXX") puis ma macro pour la création du PDF puis (ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotFields("Regroupement" _).CurrentPage = "Flux YYYY") ....

Quelqu'un pourrait m'aider s'il vous plait ?

Merci d'avance.
 

loootoo02

XLDnaute Nouveau
Re : répéter un bout de macro sous excel

Pour info, voici un bout de ma macro :

Option Explicit

Sub Tst_PdfCreator()
Dim JobPDF As Object
Dim sNomPDF As String
Dim sCheminPDF As String


ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotFields("Regroupement" _
).CurrentPage = "Flux XXXX"

sNomPDF = "Synthèse " & ActiveSheet.Range("A3") & "_" & Range("A2") & ".pdf"
sCheminPDF = ThisWorkbook.Path & "\"

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



ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotFields("Regroupement" _
).CurrentPage = "Flux YYYY"

........

End Sub
 
Dernière édition:

MJ13

XLDnaute Barbatruc
Re : répéter un bout de macro sous excel

Bonjour Lootoo

Tu peux tester une macro de ce type:

Code:
Sub TCD_Affiche_Valeurs_Distinctes()
'Extrait d'un TCD en page sur le champs Nom en nommant la colonne Nom: "DBNom"
'Avec Stop: taper F8 et ctrl+shift+F8 pour continuer
Dim d As Object, Cell As Range
Set d = CreateObject("Scripting.Dictionary")
For Each Cell In Range("BDNom")
  If Cell.Value <> "" Then d(Cell.Value) = Cell.Value
Next
nbval = d.Count: MsgBox (nbval & " valeurs distinctes.")
 For Each c In d.keys
     ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotFields("Nom"). _
        CurrentPage = d(c)
        Stop
  Next c
End Sub
 

Misange

XLDnaute Barbatruc
Re : répéter un bout de macro sous excel

Bonjour,
si tu mets dans un bout de ta feuille excel tes critères XXX, YYY, ZZZ (ou peut être représentent-ils une suite logique de nombres ce qui serit encore plus simple) tu peux mettre ce nom de critère en variable et injecter la variable dans ta macro avec une boucle

Code:
...
for each K in range ("A1:A20")
Flux = K.text
ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotFields("Regroupement" _
        ).CurrentPage = Flux

...

next k
...
 

loootoo02

XLDnaute Nouveau
Re : répéter un bout de macro sous excel

Voici le code que j'ai mis :


For Each K In ActiveSheet.PivotTables("sheet2").Range("A1:A58")
Flux = K.Text
Sheets("Synthèse").Activate
ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotFields("Regroupement" _
).CurrentPage = Flux

sNomPDF = "Synthèse " & ActiveSheet.Range("A3") & "_" & Range("A2") & ".pdf"
sCheminPDF = ThisWorkbook.Path & "\"


Cela me dit "erreur de compilation, variable K non définie"
 
Dernière édition:

Misange

XLDnaute Barbatruc
Re : répéter un bout de macro sous excel

C'est parce que tu dois avoir mis (et c'est très bien !) option explicit en début de module, ce qui t'oblige à déclarer et à typer tes variables
ajoute dim k as integer en début de macro.
 

loootoo02

XLDnaute Nouveau
Re : répéter un bout de macro sous excel

Merci

J'ai essayé, mais ca me fait pareil.

Par contre, si je met mes "nom de flux" sur la feuille de mon tableau croisé, ca marche en simplifiant un peu la première ligne. On est obligé d'avoir les "nom" sur la même feuille que le tableau croisée ?
 

Misange

XLDnaute Barbatruc
Re : répéter un bout de macro sous excel

Si tu prenais la peine de joindre un PETIT classeur exemple, ça permettrait de tester et de ne pas faire de proposition dans le vide !
Si ta liste de codes n'est pas sur la meme feuille il suffit de le préciser dans la macro :
Code:
for each K in sheets("mafeuil").range ("A1:A20")

Merci d'utiliser les balises de code pour le code VBA (le signe dièse dans le mode avancé)
 

loootoo02

XLDnaute Nouveau
Re : répéter un bout de macro sous excel

Misange, effectivement, j'aurais du mettre un petit classeur, mais comme je me sentait proche d'y arriver ...
En tout cas, ca marche chez moi, reste plus qu'à tester au taf sous 2003 ... ;)

merci à tous, je vous tiens au courant ;)
 

loootoo02

XLDnaute Nouveau
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:D43")
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
 

Misange

XLDnaute Barbatruc
Re : répéter un bout de macro sous excel

Quand tu mets le code d'une macro, merci d'aller en mode avancé, de cliquer sur le # et d'insérer ton code entre les balises [ code ] et [ /code ] ça rend les choses beaucoup plus lisibles...

Si tu dois faire travailler ta macro dans 2 feuilles différentes, il faut mettre le code dans un module ordinaire et appeler cette macro par exemple avec un bouton mis sur la feuille.
Un peu de lecture te sera peut être utile (je pense)
Les macros Excel | www.excelabo.net
 
Dernière édition:

Discussions similaires

Statistiques des forums

Discussions
312 839
Messages
2 092 695
Membres
105 511
dernier inscrit
karimdauphins