1 pièce(s) jointe(s)
Synchronisation de plusieurs TCD
Bonjour,
J'aurai voulu de l'aide concernant un problème que je n'arrive pas à résoudre sur la synchronisation de mes TCD. Mon classeur excel contient une vingtaine de tableaux pour 4 onglets et j'aurai souhaité mettre à jour tous les tableaux à partir du premier. J'ai cherché sur le forum des réponses et j'ai trouvé ce code que j'ai essayé d'adapter au module 1:
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
| Option Explicit
Sub OneForAll()
Dim PT_MAIN As PivotTable
Dim PT As PivotTable
Dim PFN(), PF As Integer, P, I
ActiveWorkbook.RefreshAll
Set PT_MAIN = ActiveSheet.PivotTables("1")
I = 1
For PF = 1 To PT_MAIN.PivotFields("Date").PivotItems.Count
If Not PT_MAIN.PivotFields("Date").PivotItems(PF).Visible Then
ReDim Preserve PFN(1 To I)
PFN(I) = PT_MAIN.PivotFields("Date").PivotItems(PF).Name
I = I + 1
End If
Next PF
On Error GoTo ShowAll
I = UBound(PFN)
On Error GoTo 0
For Each PT In ActiveSheet.PivotTables
If Not PT.Name = PT_MAIN.Name Then
With PT
PT.PivotFields("Date").EnableMultiplePageItems = True
For Each P In PT.PivotFields("Date").PivotItems
P.Visible = True
Next P
If Not I = 0 Then
For PF = 1 To I
PT.PivotFields("Date").PivotItems(PFN(PF)).Visible = False
Next PF
End If
End With
End If
Next PT
Exit Sub
ShowAll:
I = 0
Resume Next
End Sub |
et ce code sur la feuille 2
Code:
1
2
3
4
5
6
7
8
9
10
11
| Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, [B1]) Is Nothing Then
OneForAll
End If
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
End Sub |
Or à chaque fois que j'essaye de changer la date sur mon premier tableaux une erreur intervient et je n'arrive pas à savoir pourquoi !
Merci d'avance et ci-joint mon fichier test.
Bonsoir scarlisse, le forum,
Il faut poster dans la partie "Macro et VBA Excel".
un code sur internet:
Citation:
Changer tous les tableaux croisés dynamiques, lorsque vous modifiez un filtre de rapport dans un tableau croisé dynamique.
Par exemple, si vous changez le filtre « Item » dans un rapport de tableau croisé dynamique, tous les tableaux croisés dynamiques d'autres avec un « Item » comme filtre vont changer. Ils récupèrent les mêmes paramètres pour le filtre que ceux qui étaient dans le tableau croisé dynamique que vous avez changé.
Le tableau croisé dynamique avec plusieurs filtrages fonctionne avec la programmation d'événements. Il ya « Worksheet_PivotTableUpdate » pour chaque feuille de calcul, et il s'exécute lorsque toutes les tableaux croisés synamiques sur la feuille de calcul sont modifiés ou actualisés.
Pour chaque champ « filtre de rapport », le code vérifie pour le réglage de « la sélection multiples des éléments », et change tous les tableaux croisés dynamiques par le même champ filtré. Le code parcourt toutes les feuilles de calcul dans le fichier, et pour chaque tableau croisé dynamique sur chaque feuille.
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
| Private Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable)
Dim wsMain As Worksheet
Dim ws As Worksheet
Dim ptMain As PivotTable
Dim pt As PivotTable
Dim pfMain As PivotField
Dim pf As PivotField
Dim pi As PivotItem
Dim bMI As Boolean
On Error Resume Next
Set wsMain = ActiveSheet
Set ptMain = Target
Application.EnableEvents = False
Application.ScreenUpdating = False
For Each pfMain In ptMain.PageFields
bMI = pfMain.EnableMultiplePageItems
For Each ws In ThisWorkbook.Worksheets
For Each pt In ws.PivotTables
If ws.Name & "_" & pt <> wsMain.Name & "_" & ptMain Then
pt.ManualUpdate = True
Set pf = pt.PivotFields(pfMain.Name)
bMI = pfMain.EnableMultiplePageItems
With pf
.ClearAllFilters
Select Case bMI
Case False
.CurrentPage = pfMain.CurrentPage.Value
Case True
.CurrentPage = "(All)"
For Each pi In pfMain.PivotItems
.PivotItems(pi.Name).Visible = pi.Visible
Next pi
.EnableMultiplePageItems = bMI
End Select
End With
bMI = False
Set pf = Nothing
pt.ManualUpdate = False
End If
Next pt
Next ws
Next pfMain
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub |
