Mettre à jour table pivot avec macro et loop

Version imprimable

Bonjour à tous,

en cherchant un peu sur le net j'ai trouvé un code qui me permet de mettre à jour ma table pivot sur base d'une valeur dans une cellule (G2)

ce que je souhaite maintenant, c'est de faire tourner cette macro en boucle pour les différentes valeurs se trouvant sous la cellule G2 et que pour chaque valeur il me sauvegarde le résultat sous un fichier (PDF) avec comme nom la valeur de la cellule.

seulement, je bug et ne sais pas trop comment faire la boucle et pour la sauvegarde en PDF, je bug aussi

un peu d'aide serait le bienvenu :?

voici ce que j'ai pour le moment :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
Sub SaveWorkbook()
 
Dim Chemin1$, Client$, Fichier$, Jour$
 
Chemin1 = "C:\Documents and Settings\Maurizio\Mes documents"
Jour = Format(Now(), "yyyymmdd")
Client = Range("B1")
Fichier = "NetPrice" & "_" & Client & "_" & Jour & ".xls"
 
If Dir(Chemin1 & Client, 16) = "" Then MkDir Chemin1 & Client
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Chemin1 & Client & "\" & Fichier
 
End Sub
----------------------------------------------------------
Sub PivotTableFilter()
 
 
' Variable Declaration
  Dim pvtItem As PivotItem
  Dim pvt As PivotTable
  Dim pvtField As PivotField
  Dim sItem As String
 
 
' Assign the starting variable values
  ' PivotTables & PivotFields are Objects, so use a Set statement
    Set pvt = Worksheets("Feuil4").PivotTables("Tableau croisé dynamique2")
    Set pvtField = pvt.PivotFields("customer")
  ' non-Object variables don't use Set
    sItem = Worksheets("customer").Range("G2").Value
 
 
'Don't show the alert message boxes
    Application.DisplayAlerts = False
'Hide the screens while the macro is running
    Application.ScreenUpdating = False
 
 
' Refresh Pivot Table (optional - can remove)
  pvt.PivotCache.Refresh
 
 
' Delete ghost PivotItems
  For Each pvtItem In pvtField.PivotItems
    On Error Resume Next
    pvtItem.Delete
    On Error GoTo 0
  Next pvtItem
 
 
' Test for valid filter value
  On Error GoTo InvalidFilter
  pvtField.PivotItems(sItem).Visible = True
  On Error GoTo 0
 
 
' Loop though PivotItems
  For Each pvtItem In pvtField.PivotItems
    If pvtItem = sItem Then
      pvtItem.Visible = True
    Else
      pvtItem.Visible = False
    End If
  Next pvtItem
 
 
 
' Stop the code so it doesn't do the InvalidFilter bit
Exit Sub
 
 
' This runs if there was an error in the test
InvalidFilter:
  MsgBox ("The filter """ & sItem & """ doesn't exist")
 
SaveWorkbook
 
 
'Don't show the alert message boxes
    Application.DisplayAlerts = True
 
'Show the screens while the macro is running
    Application.ScreenUpdating = True
 
 
End Sub

je n'arrive pas à joindre le fichier
Merci à vous pour votre aide !!!

25/01/2011, 06h54
Qwazerty

Salut et bienvenu

Pour mettre du code dans tes messages utilise le bouton # dans l’éditeur plutôt que le bouton Citation.

Pour ton problème, précise ta version d'Excel, parce qu'Excel 2007, il a une fonction pour généré un PDF .... avant ... non :s

Fait quelques recherches sur Google.

Pour ta boucle, regarde du coté de For et For Each

Bonne journée
++
Qwaz

1 pièce(s) jointe(s)

[XL-2007] Mettre à jour table pivot avec macro et loop

Re

j'utilise la version 2007

entre-temps j'ai encore pas mal cherché et j'y suis presque.
le code est devenu bien plus simple :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
Sub SaveAsPDF()
 
Dim Chemin1$, Client$, Fichier$, Jour$
 
Jour = Format(Now(), "yyyymmdd")
Client = Range("B1")
Fichier = "NetPrice" & "_" & Client & "_" & Jour & ".pdf"
 
    SaveFolder = "Z:\COMMERCIAL\StSc\"
    Client = Range("B1")
    DocName = "NetPrice" & "_" & Client & "_" & Jour
    FileExt = ".xlsx"
 
' Save as PDF
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, FileName:=SaveFolder & DocName, Quality:=xlQualityStandard, _
    IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
    False
 
 
End Sub
 
Sub Loop_PivotItems()
    Sheets("Filter Table").Select
    'to select the sheet with the pivot table
'Loop through every PivotItem in the PageField (Filter) of the Pivot Table
    For Each PivotItem In ActiveSheet.PivotTables(1).PageFields(1).PivotItems
'Select the PivotItem
        ActiveSheet.PivotTables(1).PageFields(1).CurrentPage = PivotItem.Value
'Do whatever you need here....
    SaveAsPDF
 
Next
End Sub

Le SaveAsPDF fonctionne parfaitement

le seul binz, c'est que je n'arrive pas a arreter ma boucle, qui tourne en continu ...

merci pour votre aide

26/01/2011, 20h25
stsc01

Re,

je ne sais pas comment c'est possbile, mais mon code pour le loop qui fonctionnait bien, sauf que je ne sait toujours pas comment arreter le loop, me donne maintenant un "Runtime error 5 - Argument ou appel de procedure incorrect"

quelqu'un peut-il m'aider car je ne m'en sort plus :(

merci !!
26/01/2011, 21h48
Qwazerty

Salut
Faudrait donner plus de précision, par ce que chez moi ton code me crée 11 pdf et la boucle se termine normalement... quand elle a traité tous les pivots.
++
Qwaz
26/01/2011, 22h47
stsc01

en fait, il fait le premier loop (il sauvegarde donc correctement en pdf la première valeur de la table pivot) et ensuite j'ai le runtime error sur la ligne

Code:

ActiveSheet.PivotTables(1).PageFields(1).CurrentPage = PivotItem.Value

...
je viens encore d'essayer mais sans j'ai toujours le bug

merci

SAlut
Essai sans les select

Code:

1
2
3
4
5
6
7
8
9
10
11
12
Sub Loop_PivotItems()
    'Sheets("Filter Table").Select
    'to select the sheet with the pivot table
'Loop through every PivotItem in the PageField (Filter) of the Pivot Table
    For Each PivotItem In Sheets("Filter Table").PivotTables(1).PageFields(1).PivotItems
'Select the PivotItem
        Sheets("Filter Table").PivotTables(1).PageFields(1).CurrentPage = PivotItem.Value
'Do whatever you need here....
    SaveAsPDF
 
Next
End Sub

++
Qwaz

26/01/2011, 23h09
stsc01

sans le select, il passait par les 2 premiers loop et ensuite à nouveau runtime error

MAIS, et en fait je ne sais pas si ça a avoir, j'ai, avant de lancer le code, mis mon filtre de table pivot sur "All" et tout d'un coup ça fonctionne ...

bref, cette fois, j'espere que c'est bon

je déclare donc ce post résolu et je te remercie pour ton aide !!!!:D

A+