VBA / Automatisation de filtres TCD

[FlorianQ]

Bonjour le forum,

Je crée une nouvelle discussion car je suis en face d'un nouveau problème.
Je dispose à l'heure actuelle d'environ 20 TCD (et il tend a il y en avoir de plus en plus) et en vue de les exporter périodiquement, je voulais faciliter la modification des filtres en ne les changeant qu'une fois pour tous les TCD. J'ai plusieurs filtres sur mes TCD mais il y en a principalement deux que j'aimerai changer à chaque fois, j'ai donc créé une liste déroulante de mes différentes options et lors de la sélection d'une entrée, je souhaitais que mes TCD se mettent à jour.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("B3:C3")) Is Nothing Or Target.Cells.Count > 2 Then Exit Sub
    Dim Sh As Worksheet, Pt As PivotTable
    For Each Sh In Worksheets
        For Each Pt In Sh.PivotTables
            With Pt.PivotFields("Agence")
                .CurrentPage = Range("$B$3").Value
            End With
            With Pt.PivotFields("UC")
                .CurrentPage = Range("$C$3").Value
            End With

        Next Pt
    Next Sh
End Sub

J'obtiens l'erreur suivante "Impossible de définir la propriété CurrentPage de la classe PivotField". Je vous ai joint une base factice pour un peu mieux cerner le problème. Je constate que sur cette base lorsque que je change l'agence, même si j'ai le message d'erreur, les filtres se mettent à jours. Ce n'est pas le cas sur mon fichier d'origine.

Merci d'avance en espérant avoir été assez précis.

 

[Iznogood1]

Re : VBA / Automatisation de filtres TCD

Bonjour,

Tu n'as pas le champ "Agence" dans les champs filtrés te ton "Tableau croisé dynamique 1"
(celui sur la feuille "Données" à partir de la cellule D7)

D'où l'erreur.

Une suggestion : pour éviter des appels multiples à ta macro ajoute les lignes en gras :

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("B3:C3")) Is Nothing Or Target.Cells.Count > 2 Then Exit Sub
Application.EnableEvents = False
Dim Sh As Worksheet, Pt As PivotTable
For Each Sh In ThisWorkbook.Worksheets
For Each Pt In Sh.PivotTables
With Pt.PivotFields("Agence")
.CurrentPage = Range("$B$3").Value
End With
With Pt.PivotFields("UC")
.CurrentPage = Range("$C$3").Value
End With

Next Pt
Next Sh
Application.EnableEvents = True
End Sub

 

[FlorianQ]

Re : VBA / Automatisation de filtres TCD

Bonjour Iznogood, et merci pour ta rapide réponse.

Du coup comment puis-je faire pour que cela soit effectif sur les TCD qui possèdent au moins l'un de ces deux filtres ? Est-ce-que je peux sélectionner seulement les TCD où cela m'intéresse ?

 

[chris]

Re : VBA / Automatisation de filtres TCD

Bonjour à tous

Il faut tester le nom du TCD pour les cas où le champs agence n'existe pas...
Je te conseille de nommer tes TCD de façon plus élaborée afin de gérer plus facilement : par exemple avoir un nom qui commence de la même façon pour ceux qui ont ou n'ont pas tel champ en zone de page facilitera le test tout en te permettant de t'y retrouver...

Le target.Cells.Count doit être comparé à 1 : on ne traite qu'une cellule à la fois.

Si tous tes TCD sont sur le même onglet, la boucle

For Each Sh In Worksheets

peut être enlevée.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("B3:C3")) Is Nothing Or Target.Cells.Count > 1 Then Exit Sub
    Dim Sh As Worksheet, Pt As PivotTable
    Application.EnableEvents = False
    For Each Sh In Worksheets
        For Each Pt In Sh.PivotTables
            Select Case Target.Address
                Case "$B$3"
                    If Pt.Name <> "Tableau croisé dynamique1" Then
                        With Pt.PivotFields("Agence")
                            .CurrentPage = Range("$B$3").Value
                        End With
                    End If
                Case "$C$3"
                    With Pt.PivotFields("UC")
                        .CurrentPage = Range("$C$3").Value
                    End With
                End Select
        Next Pt
    Next Sh
    Application.EnableEvents = True
End Sub

 

[FlorianQ]

Re : VBA / Automatisation de filtres TCD

Bonjour Chris, et merci pour tes précisions

Du coup je pense avoir compris comment résoudre mon problème cependant impossible de tester, lorsque je change d'agence, il ne se passe rien, et si je vais dans le code et que je fais du pas-par-pas, il ne se passe absolument rien. J'ai essayé avec ce code

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("BE6:BF6")) Is Nothing Or Target.Cells.Count > 1 Then Exit Sub
    Application.EnableEvents = False
    Dim Sh As Worksheet, Pt As PivotTable
            Select Case Target.Address
                Case "$BE$6"
            If Pt.Name = "Sains1" Or "Sains2" Or "Sains3" Or Sains4" Then
            With Pt.PivotFields("Libellé Agence") 'Je suis repassé sur mon fichier d'origine et "Libellé Agence" correspond bien à "Agence"
                .CurrentPage = Range("$BE$6").Value
            End With
            End If
              Case "$BE$6"
              If Pt.Name = "TCD5" Then
            With Pt.PivotFields("UC")
                .CurrentPage = Range("$BF$6").Value
            End With
            End If
        Next Pt
Application.EnableEvents = True
End Sub

 

[chris]

Re : VBA / Automatisation de filtres TCD

RE

Il semble manquer le end select : bizarre que tu n'aies pas d'erreur.
De même la syntaxe de test des noms n'est pas bonne. Il faut

Pt.Name = "Sains1" Or Pt.Name = "Sains2" Or...

 

[FlorianQ]

Re : VBA / Automatisation de filtres TCD

Re,

Malheureusement après quelques correctifs, toujours rien. Cela m'intrigue que je ne puisse pas utiliser le pas-par-pas.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("BE6:BF6")) Is Nothing Or Target.Cells.Count > 1 Then Exit Sub
    Application.EnableEvents = False
    Dim Pt As PivotTable
        For Each Pt In Sh.PivotTables
            Select Case Target.Address
                Case "$BE$6"
            If Pt.Name = "Sains1" Or Pt.Name = "Sains2" Or Pt.Name = "Sains3" Or Pt.Name = "Sains4" Then
            With Pt.PivotFields("Libellé Agence")
                .CurrentPage = Range("$BE$6").Value
            End With
            End If
              Case "$BE$6"
              If Pt.Name = "TCD5" Then
            With Pt.PivotFields("UC")
                .CurrentPage = Range("$BF$6").Value
            End With
            End If
        End Select
        Next Pt
Application.EnableEvents = True
End Sub

 

[chris]

Re : VBA / Automatisation de filtres TCD

Re

Mets un point d'arrêt sur la ligne if intersect... et modifie une valeur d'agence ou UC. La macro doit démarrer et attendre que tu agisses avec F8.

Si la macro ne démarre pas crée une macro d'une ligne avec

Application.EnableEvents = True

et exécute-là car tu as pu désactivé la gestion d'évènements au cours de tests...

 

[FlorianQ]

Re : VBA / Automatisation de filtres TCD

Re,
J'ai maintenant l'erreur "Objet requis" qui pointe sur

For Each Pt In Sh.PivotTables

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("BE6:BF6")) Is Nothing Or Target.Cells.Count > 1 Then Exit Sub
'    Application.EnableEvents = False
    Dim Pt As PivotTable
        For Each Pt In Sh.PivotTables
            Select Case Target.Address
                Case "$BE$6"
            If Pt.Name = "Sains1" Or Pt.Name = "Sains2" Or Pt.Name = "Sains3" Or Pt.Name = "Sains4" Then
            With Pt.PivotFields("Libellé Agence")
                .CurrentPage = Range("$BE$6").Value
            End With
            End If
              Case "$BE$6"
              If Pt.Name = "TCD5" Then
            With Pt.PivotFields("UC")
                .CurrentPage = Range("$BF$6").Value
            End With
            End If
        End Select
        Next Pt
'Application.EnableEvents = True
End Sub

 

[chris]

Re : VBA / Automatisation de filtres TCD

Re

Si tu enlèves la boucle sheets il n'est pas nécessaire mais même ici néfaste de se référer à une feuille Sh.

Remplace

Sh.PivotTables

par

PivotTables

puisque tu es dans le module de la feuille concernée

 

[FlorianQ]

Re : VBA / Automatisation de filtres TCD

Euréka !

Décidemment les fautes d'inattention, ça peut vite poser problème...
Les modifications s'effectuent bien sur les TCD concernés pour ce qui est de l'agence. Par contre lorsque je change l'UC, rien ne se passe pour le TCD5, faut-il passer par une seconde macro ?

Encore merci pour l'aide déjà apportée !

 

[chris]

Re : VBA / Automatisation de filtres TCD

Re

Sur ton fichier exemple tous les TCD ont un champ UC : pourquoi limiter à TCD5 ?

Sur ton exemple, sans if sur le TCD la macro applique le filtre à tous les TCD.

Le code réagit à chaque changement : si tu modifies l'agence, il filtre l'agence, si tu modifies l'UC il modifie l'UC.

Un détail : dans le code tu peux remplacer

Range("$BE$6").Value

et

Range("$BF$6").Value

par

target.value

Cela limite les modifs en cas de réutilisation ou modification.

 

[FlorianQ]

Re : VBA / Automatisation de filtres TCD

Re,

Le fait est que j'ai mal représenté sur l'exemple ce que je voulais faire.
Il se peut qu'un TCD dispose de UC et agence en terme de filtre, cependant il peut arriver qu'il n'y en ai que l'un des deux, c'est ce qui arrive sur mon fichier et qui n'est pas présent en tant qu'exemple. Il peut arriver que pour un TCD j'ai un filtre prédéfini qui ne doit pas être modifié (c'est pour cette raison que j'utilise le if), qui pourrait être une agence ou UC à titre de comparaison. Alors que ce tableau va se comparer à un autre qui lui se modifiera avec la liste déroulante.

C'est là où se trouve la particularité un peu compliqué à expliquer, dans la base d'exemple, il faut imaginer (ou modifier) un TCD, pour ne mettre que l'UC en filtre (et d'autres choses éventuellement sauf Agence) et que celui-ci se mette à jour

 

[chris]

Re : VBA / Automatisation de filtres TCD

Re

A toi de mettre les conditions pour préciser l'action.

Comme expliqué chaque changement d'une valeur dans tes cellules BE6:FE6 (ou plus si tu élargis la macro selon le même principe, en ajoutant des Case dans la structure Select Case) déclenche une seule mise à jour des filtres des TCD concernés.

Il n'y a aucun raison que le code ne fasse rien sur le TCD5 et ne renvoie pas d'erreur...

Garde ton point d'arrêt et exécute le code jusqu'au bout afin de tester divers changements de tes cellules BE6:FE6.

Les segments de 2010 et + sont quand même une super invention !

 

[FlorianQ]

Re : VBA / Automatisation de filtres TCD

Re,

J'essaierai demain matin sur un autre TCD pour voir mais ici je confirme que rien ne se passait, et pas de message d'erreur, évidemment...
Je verrais bien si cela vient du tableau ou non.

Effectivement les segments ont l'air d'être une sacrée innovation