Filtre TCD par cellule

Le 19/10/2015 à 16:40

Bonjour,

J'ai un fichier Excel (2007) avec plusieurs feuilles et plusieurs tableaux croisés dynamiques sur 2 de ces feuilles.

Je souhaite filtre les TCD de la derniere feuille en choisissant une valeur dans une liste déroulante.

Mes recherches ont pour l'instant menées à :

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Address <> "$A$1" Then Exit Sub

Dim Sh As Worksheet, Pt As PivotTable

For Each Sh In Worksheets

For Each Pt In Sh.PivotTables

With Pt.PivotFields("Etablissement")

.ClearAllFilters

.CurrentPage = Target.Value

End With

Next Pt

Next Sh

End Sub

Etablissement étant ma catégorie de filtre dans lesquels j'ai CNRS, UJM, ENS, etc.

La ligne .CurrentPage = Target.Value me renvoie une erreur : erreur d’exécution 1004. Impossible de définir la propriété CurrentPage de la classe Pivot.Field.

Je connais peu vba, surtout les fonctions "complexes" autre que if, for et toutes les bases, du coup je ne comprend pas ce que doit renvoyer CurrentPage, un nom de feuille?

Quand je souhaite filtrer "CNRS" dans mes TCD, le débogage me montre que "Target.Value" prend "CNRS" comme valeur.

J'espère avoir été clair. Mon fichier est très lourd et mes tableaux font référence à plusieurs feuilles, c'est pourquoi je ne l'ajoute pas pour le moment!

Merci de votre aide,

Danagos.

Le 19/10/2015 à 17:38

bonjour

solution de dépannage : créer une colonne de pointage dans le(s) tables de données

tu crées :

  • une cellule dans laquelle l'utilisateur va saisir la valeur recherchée. Tu peux y mettre une liste déroulante. Disons la cellule Z99
  • une colonne supplémentaire à ton tableau de données. Tu peux mettre en tête POINTAGE et y inscrire = SI(tacolonneàtester = $Z$99 ; 1 ; ""), formule à mettre dans toute la colonne. Elle contient 1 ou rien selon la valeur en Z99.
  • tu ajoutes POINTAGE dans ton TCD et tu filtres la valeur 1

une grande partie de ces manœuvres peuvent se faire en macro. Tu es plus calé que moi en ce domaine.

Le 20/10/2015 à 09:33

Bonjour,

Il serait intéressant de savoir si on parle de champs de page (xlPageField) ou de champs de colonnes (xlColumnField), ou encore de champs de lignes (xlRowField).

Essaie cette procédure.

A te relire.

Cdlt.

106xlp-danagos-filtres-tcds-vba-v1.xlsm (21.82 Ko)
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Sh As Worksheet
Dim Pt As PivotTable
Dim pi As PivotItem
Dim strPF As String

    If Target.Address <> "$A$1" Then Exit Sub

    On Error GoTo Err_Handler

    With Application
        .EnableEvents = False
        .ScreenUpdating = False
    End With

    strPF = "Produit"

    For Each Sh In ActiveWorkbook.Worksheets
        For Each Pt In Sh.PivotTables
            Pt.ManualUpdate = True
            Select Case Pt.PivotFields(strPF).Orientation
                Case xlPageField
                    With Pt.PageFields(strPF)
                        .ClearAllFilters
                        .CurrentPage = Target.Value
                    End With
                Case xlColumnField, xlRowField
                    With Pt.PivotFields(strPF)
                        .ClearAllFilters
                        For Each pi In Pt.PivotFields(strPF).PivotItems
                            If pi.Name <> Target.Value Then pi.Visible = False
                        Next pi
                    End With
                Case Else
                    '
            End Select
            Pt.ManualUpdate = False
        Next Pt
    Next Sh

exit_Handler:
    Application.EnableEvents = True
    Exit Sub

Err_Handler:
    MsgBox "Erreur " & Err.Number & " : " & Err.Description
    Resume exit_Handler

End Sub
Le 20/10/2015 à 15:44

Bonjour,

merci de ton aide, je vois ça demain. Ce matin réunion et cette aprem je suis sur mon ordi perso et c'est la version 2010. j'ai pas envie de rendre le fichier bugué sous 2007 ensuite!

Je vous tiens au courant pour ce qu'il en est dans la matinée je pense!

Cdt,

Danagos.

Le 20/10/2015 à 15:51

Re,

Les versions d'Excel n'ont rien à voir avec la procédure envoyée (normalement ).

La question est de savoir quels sont les types de champs à filtrer.

Cdlt.

Le 22/10/2015 à 10:08

Bonjour,

Alors c'est exactement ce qu'il me faut! Filtre sur colonne et ligne. ça va dépendre du type de TCD que j'ai. Est-il possible de ne modifier uniquement que les TCD de la feuille en cours (ou feuille n°X, peu importe).

En gros j'ai la même feuille 3 que dans ton fichier exemple, avec 3 fois plus de TCD, mais ça reste le même principe. En revanche, quand j'actualise ma cellule, une erreur provient, possiblement car les TCD des autres feuilles cherchent à se mettre à jour eux aussi?

En fait c'est toujours l'erreur 1004 qui survient...

EDIT 10h16 : Je viens de comprendre un truc. Tu intègres le nom du TCD dans le code, "produit" dans l'exemple. Je peux pas me permettre de faire une boucle pour chaque TCD, trop long et lourd. Je continue de regarder le code pour essayer de trouver la solution par moi même.

EDIT n°2 : 11h48 : En fait ça fonctionne très bien... je ne suis pas très futé quand je comprend pas quoi fait quoi. Suffisait juste de changer "Produit" avec le nom général de mon filtre (Etablissement dans mon cas).

Reste le soucis que les TCD de mes autres feuilles se mettent eux aussi à jour alors que je souhaite les garder pleins, sans filtre. J'ai essayé de transformer Worksheets en Worksheets("feuil3") mais nop :/

Le 22/10/2015 à 14:32

J'ai finalement trouvé grâce à ton aide précieuse.

Il m'a suffit d'ajouter une boucle If dans celle qui parcourt toutes les feuilles, en ne gardant que celle avec le bon nom.

Au final le code :

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Sh As Worksheet
Dim Pt As PivotTable
Dim pi As PivotItem
Dim strPF As String

    If Target.Address <> "$A$1" Then Exit Sub

    On Error GoTo Err_Handler

    With Application
        .EnableEvents = False
        .ScreenUpdating = False
    End With

    strPF = "Etablissement"

    For Each Sh In ActiveWorkbook.Worksheets
        If Sh.Name = "Monographies" Then
        For Each Pt In Sh.PivotTables
            Pt.ManualUpdate = True
            Select Case Pt.PivotFields(strPF).Orientation
                Case xlPageField
                    With Pt.PageFields(strPF)
                        .ClearAllFilters
                        .CurrentPage = Target.Value
                    End With
                Case xlColumnField, xlRowField
                    With Pt.PivotFields(strPF)
                        .ClearAllFilters
                        For Each pi In Pt.PivotFields(strPF).PivotItems
                            If pi.Name <> Target.Value Then pi.Visible = False
                        Next pi
                    End With
                Case Else
                    '
           End Select
            Pt.ManualUpdate = False
        Next Pt
        End If
    Next Sh

exit_Handler:
    Application.EnableEvents = True
    Exit Sub

Err_Handler:
    MsgBox "Erreur " & Err.Number & " : " & Err.Description
    Resume exit_Handler

End Sub

Merci beaucoup pour ton aide Jean-Eric.

Cordialement,

Danagos.

Le 22/10/2015 à 14:38

Bonjour,

J'ai modifié ma procédure pour un problème d'existence de champ dans les TCDs (à tester).

Peux-tu envoyer un fichier car je n'ai pas le temps d'en créer et que je ne sais pas vraiment ce que tu veux faire.

Cdlt.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Sh As Worksheet
Dim pt As PivotTable
Dim pi As PivotItem
Dim strPF As String, strTemp As String

    If Target.Address <> "$A$1" Then Exit Sub

    On Error GoTo Err_Handler

    With Application
        .EnableEvents = False
        .ScreenUpdating = False
    End With

    strPF = "Produit"   ' Remplacer par xxx pour tester la procédure.

    For Each Sh In ActiveWorkbook.Worksheets
        For Each pt In Sh.PivotTables
           On Error Resume Next
            strTemp = pt.PivotFields(strPF)
            If Err = 0 Then
                pt.ManualUpdate = True
                Select Case pt.PivotFields(strPF).Orientation
                    Case xlPageField
                        With pt.PageFields(strPF)
                            .ClearAllFilters
                            .CurrentPage = Target.Value
                        End With
                    Case xlColumnField, xlRowField
                        With pt.PivotFields(strPF)
                            .ClearAllFilters
                            For Each pi In pt.PivotFields(strPF).PivotItems
                                If pi.Name <> Target.Value Then pi.Visible = False
                            Next pi
                    End With
                    Case Else
                        '
                End Select
                pt.ManualUpdate = False
                On Error GoTo 0
            Else
               MsgBox "le champ spécifié n'existe pas dans " & pt.Name
                On Error GoTo 0 
           End If
        Next pt
    Next Sh

exit_Handler:
    Application.EnableEvents = True
    Exit Sub

Err_Handler:
    MsgBox "Erreur " & Err.Number & " : " & Err.Description
    Resume exit_Handler

End Sub
Le 23/10/2015 à 10:18

Je vais ajouter tes modifs alors, si ça peut éviter des erreurs.

Le code que tu m'as envoyé et tout à fait fonctionnel par rapport à ma demande, je te remercie.

Pour le fichier comme je t'ai dit il est laaaaaaargement trop volumineux et les données sont confidentielles quoi qu'il arrive.

Plus besoin de t’embêter pour moi, tu as déjà résolu mon soucis

Cordialement,

Danagos.

'Les carottes domineront les lapins'

Rechercher des sujets similaires à "filtre tcd"