Code de filtre unique agissant sur plusieurs TCD, Soucis adaptation...

Pygouv

XLDnaute Occasionnel
Bonsoir à tous,

J'utilise un code (que vous trouverez sur l'onglet résumé de mon fichier exemple), qui permet en choississant un filtre d'agir sur les autres TCDs sur les autres onglets automatiquement, ce qui permet d'actualiser des graphiques sur la même page en fonction d'un filtre unique et ne pas devoir aller sur les onglets ou se situent ces TCDs pour réaliser le filtrage...

Je ne comprends pas pourquoi mon code ne fonctionne plus... Si vous pouvez m'expliquer ce qui cloche dans mon code ce serait génial!

En PJ un fichier exemple

Mille merci, vous me sortirez d'un gros soucis, car je dois utiliser ce filtre unique pour une bonne dizaine d'onglet en temps normal...

Bonne soirée et bon WE le forum!
 

Pièces jointes

  • Filtre unique.xlsm
    48.3 KB · Affichages: 55
G

Guest

Guest
Re : Code de filtre unique agissant sur plusieurs TCD, Soucis adaptation...

Bonjour,

Cela semble fonctionner avec les quelques changements dans la macro et lancement sur évènement Worksheet_PivotTableUpdate de la feuille résumé.
La macro est dans un module.
Sans doute avais-tu oublié de parcourir toutes les feuilles pour agir sur leur TCD.

A+
 

Pygouv

XLDnaute Occasionnel
Re : Code de filtre unique agissant sur plusieurs TCD, Soucis adaptation...

Bonjour Hasco,

J'ai finalement utiliser ce code ci qui fonctionne partout, et que j'ai trouvé sur un forum. Saurais tu comment faire pour que les TCDs ne prennent pas le "vide en compte" car je ne le sélectionne pas dans le filtre directeur mais il se sélectionne automatiquement dans les TCDs dépendant...

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

Encore merci à toi!
 

Discussions similaires

Statistiques des forums

Discussions
311 709
Messages
2 081 774
Membres
101 816
dernier inscrit
Jfrcs