Discussion :

[scarlisse]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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.

[ESVBA]

Il faut poster dans la partie "Macro et VBA Excel".

un code sur internet:

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[scarlisse]

Merci beaucoup ESVBA c'est la bon code pour synchroniser plusieurs tableaux croisé dynamique.
Il suffit juste de remplacer le nom du premier TCD de notre feuille sur la ligne 22 ("_") et le nom de la cellule sur la ligne 32 ("A11") ou le filtre choisit intervient.