Slicer ajouter enlever des connexions via une boucle
Bonjour,
J'ai un classeur avec pleins de TCD basés sur la même source, avec également pleins de slicer connectés à tous ces TCD.
Ajoutant des informations (colonnes) à ma source de données je dois modifier la source de mes TCD
Or si je modifie un par un mes sources de TCD j'ai une erreur a cause des connexions aux slicers.
Sachant que je ne sais pas modifier la source de tout les TCD en même temps (Est-ce possible ?) je dois donc enlever toutes les connexions avant de faire la maj puis de les remettres, vu le nombre de tableau et de segment c'est hors de question de le faire a la main, donc j'essaye de le faire par une boucle, et vous vous doutez bien que je poste ici c'est que je n'y arrive pas.
Voici ce que m'as donné l'enregistreur de macro pour la suppression:
Code:
1
2
3
| ActiveSheet.Shapes.Range(Array("b")).Select
ActiveWorkbook.SlicerCaches("Segment_b").PivotTables.RemovePivotTable ( _
ActiveSheet.PivotTables("Tableau croisé dynamique1")) |
(remplacer RemovePivotTable par AddPivotTable pour l'ajout)
Voici l'une des boucles que j'ai tenté:
Code:
1
2
3
4
5
6
| Dim pvt As PivotTable, sh As Worksheet
For Each sh In ThisWorkbook.Worksheets
For Each pvt In sh.PivotTables
ThisWorkbook.SlicerCaches("Segment_a").PivotTables.AddPivotTable (sh.PivotTables(pvt.Name))
Next
Next |
Mais j'obtient une erreur 424 objet requis sur la ligne 4.
Si quelqu'un a une solution je suis preneur :)
Merci d'avance.
edit:
Au cas où quelqu'un chercherais en même temps que moi, j'ai trouvé ça sur stackoverflow, ça a l'air d'être exactement ce que je recherche, je confirmerais après test
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
| Sub ManageSlicers(Connect_Disconnect As String)
'feed in *connect* or *disconnect* accordingly to get it applied to all slicers in *Board*.
Dim oSlicer As Slicer
Dim oSlicercache As SlicerCache
'
Dim wks As Worksheet
Dim pt As PivotTable
For Each oSlicercache In ActiveWorkbook.SlicerCaches
For Each oSlicer In oSlicercache.Slicers
If oSlicer.Shape.BottomRightCell.Worksheet.Name = "Board" Then
For Each wks In Worksheets
For Each pt In wks.PivotTables
If Connect_Disconnect = "connect" Then
oSlicer.SlicerCache.PivotTables.AddPivotTable (Sheets(wks.Name).PivotTables(pt.Name))
ElseIf Connect_Disconnect = "disconnect" Then
oSlicer.SlicerCache.PivotTables.RemovePivotTable (Sheets(wks.Name).PivotTables(pt.Name))
Else
MsgBox "Macro ManageSlicers fucked up."
End If
Next
Next
End If
Next
Next
Set oSlicer = Nothing
Set oSlicercache = Nothing
Set pt = Nothing
Set wks = Nothing
End Sub
Sub UpdatePivotCache()
'update pivottables cache
Dim wks As Worksheet
Dim pt As PivotTable
For Each wks In ActiveWorkbook.Worksheets
For Each pt In wks.PivotTables
If lIndex = 0 Then
pt.ChangePivotCache _
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, _
SourceData:=Sheets("Data").Range("A1").CurrentRegion.Address(ReferenceStyle:=xlR1C1))
Set ptMain = pt
lIndex = 1
Else
pt.CacheIndex = ptMain.CacheIndex
End If
Next pt
Next wks
End Sub
Sub RefreshSlicersAndPivots()
ThisWorkbook.RefreshAll
Call ManageSlicers("disconnect")
Call UpdatePivotCache
Call ManageSlicers("connect")
End Sub |
edit2: je confirme ça marche très bien sur mon classeur test
Problème résolu.
