Filtre TCD par cellule
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.
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.
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.
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
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.
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.
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 :/
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.
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
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'