Filtres Tableau Croisé TCD sur Table Source

JPDDN

XLDnaute Nouveau
Bonjour,

je tente de faciliter la vie de mes utilisateurs.
Usuellement, sur un TCD issu d'un onglet voisin, en double cliquant sur un total numérique, Excel crée une feuille à gauche de la feuille du TCD avec les valeurs correspondantes aux filtres posés par l'utilisateur sur le TCD. Cette feuille est l'image de l'onglet Source, elle est intitulée "Feuil" & "n" mais n'est pas formatée correctement (affichage, impression, etc...).
Je cherche donc une solution plus élégante en 2 phases :
1° - récupérer du TCD les pivots actifs et les filtres posés par l'utilisateur
2° - appliquer ces mêmes filtres à l'onglet Source.
Ainsi, l'utilisateur, en double cliquant, sera routé sur l'onglet source pour le détail de sa sélection.

Je bloque actuellement sur la phase 2. Sur la colonne "ES / CAFF", je récupére bien les filtres du TCD dans un tableau Array, par contre, sur l'onglet Source, Excel considère qu'il s'agit d'un filtre numérique et ne sélectionne pas les bons filtres ==> l'application des filtres mais la Source à blanc.

La macro associée pose pb à la ligne ActiveSheet.Range("$B$2:$L$20070").AutoFilter Field:=2, Criteria1:=critère, Operator:=xlFilterValues :


MsgBox critère
longueur = Len(critère)
critère = Left(critère, longueur - 1)
'critère = Right(critère, longueur - 1)
MsgBox critère
critère = Array(critère)
critère2 = Array("1", "2") ' 'as Variant)
' Pb ICI - probablement sur le format de 'critère'
ActiveSheet.Range("$B$2:$L$20070").AutoFilter Field:=2, Criteria1:=critère, Operator:=xlFilterValues

merci de votre aide précieuse et affutée,
Bcdlt
JDDN


macro complète : (ficheri 500 ko, ne passe pas)
Sub Récupérer_Filtres()
Dim TCD As PivotTable
Dim PT As PivotTable
Dim PFN(), PF, P, I, critère As Variant

Source = Sheets("Clients Actifs").Range("$B$2:$L$20070")

Set Liste_Champs_TCD = Worksheets("Synthèse Actifs").Range("B5").PivotTable

rw = 0

For Each Champ In Liste_Champs_TCD.VisibleFields ' Champs affichés dans le 1° TCD
Champ1 = Champ.Name
'table de référence
Set TCD = Sheets("Synthèse Actifs").PivotTables("Tableau croisé dynamique1")
I = 1
critère = Empty
'recuperer les noms de filtres actifs
For PF = 1 To TCD.PivotFields(Champ.Name).PivotItems.Count ' CHAMP PIVOT ACTIF
If TCD.PivotFields(Champ.Name).PivotItems(PF).Visible Then
'redimensionner pfn en fonction du nombre de filtres actif sur le champ AA
ReDim Preserve PFN(1 To I) 'preserve pour ne pas perdre les données précédemment inscrites
'l'ajouter
PFN(I) = TCD.PivotFields(Champ.Name).PivotItems(PF).Name
' MsgBox Champ.Name & " " & TCD.PivotFields(Champ.Name).PivotItems(PF).Name & " " & TCD.PivotFields(Champ.Name).PivotItems(PF).Visible

I = I + 1 'on incrémente en prévision du prochain filtres actif à ajouter

' Sélection = Chr(34)
If Champ1 <> "ES / CAFF" Then critère = critère & Chr(34) & TCD.PivotFields(Champ.Name).PivotItems(PF).Name & Chr(34) & ", "
If Champ1 = "ES / CAFF" Then critère = critère & Chr(34) & (TCD.PivotFields(Champ.Name).PivotItems(PF).Name) & Chr(34) & ","

' ActiveSheet.Range(Source).AutoFilter Field:=2, Criteria1:="=614", _
Operator:=xlOr, Criteria2:="=623"
' Source.AutoFilter Field:=7, Criteria1:=Array( _
"ASSOCIATIONS GESTIONNAIRES", "PME PMI", "PROFESSIONNELS DE L IMMOBILIER"), _
Operator:=xlFilterValues
End If
'Sheets("Clients Actifs").Select
Next PF



MsgBox critère
longueur = Len(critère)
critère = Left(critère, longueur - 1)
'critère = Right(critère, longueur - 1)
MsgBox critère
critère = Array(critère)
critère2 = Array("1", "2") ' 'as Variant)

ActiveSheet.Range("$B$2:$L$20070").AutoFilter Field:=2, Criteria1:=critère, Operator:=xlFilterValues

'ActiveSheet.Range("$B$2:$L$20070").AutoFilter Field:=2, Criteria1:=Array( _
"1", "10", "100", "101", "102", "103", "104", "105", "106", "107", "108", "109", "111", _
"112", "113", "114", "115", "116", "117", "118", "119", "12", "120", "121", "122", "123", _
"124", "126", "127", "128", "129", "13", "130", "131", "132", "133", "134", "135", "136", _
"137", "138", "14", "140", "141", "142", "143", "144", "145", "146", "147", "148", "149", _
"15", "150", "151", "152", "153", "155", "156", "157", "159", "16", "160", "161", "163", _
"164", "165", "166", "168", "169", "17", "170", "171", "172", "173", "174", "177", "178", _
"179", "18", "180", "182", "183", "184", "19", "2", "20", "21", "22", "23", "24", "25", "26", _
"27", "28", "29", "3", "30", "31", "32", "33", "35", "36", "39", "4", "40", "41", "43", "44", _
"45", "46", "47", "48", "49", "5", "50", "512", "52", "53", "54", "55", "56", "57", "58", "59" _
, "6", "60", "61", "613", "614", "62", "623", "624", "625", "63", "64", "65", "66", "67", "69" _
, "7", "70", "71", "72", "73", "74", "75", "76", "77", "78", "79", "8", "81", "9", "96", "97", _
"98", "99"), Operator:=xlFilterValues
' ActiveSheet.Range("$B$2:$L$20070").AutoFilter Field:=7, Criteria1:=Array("ASSOCIATIONS GESTIONNAIRES", "PROFESSIONNELS DE L IMMOBILIER"), Operator:=xlFilterValues

Next Champ

'nb de filtre inactifs
On Error GoTo ShowAll
I = UBound(PFN)
On Error GoTo 0


'les appliquer sur la table source


For Each Champ In Liste_Champs_TCD.VisibleFields

ActiveSheet.Range(Source).AutoFilter Field:=11, Criteria1:= _
"devenu actif"
ActiveSheet.Range(Source).AutoFilter Field:=7, Criteria1:= _
"=PME PMI", Operator:=xlOr, Criteria2:="=PROFESSIONNELS DE L IMMOBILIER"
ActiveSheet.Range(Source).AutoFilter Field:=5, Criteria1:= _
"DIRECTION BANQUE DE DEV REGIONAL"
ActiveSheet.Range(Source).AutoFilter Field:=2, Criteria1:="=614", _
Operator:=xlOr, Criteria2:="=623"

Next Champ


'les appliquer sur les autres tables pivot
For Each PT In ActiveSheet.PivotTables
'sauf si c'est la table pivot de référence
If Not PT.Name = TCD.Name Then
With PT
'activation de la selection multiple
PT.PivotFields("AA").EnableMultiplePageItems = True
'on affiche tout les filtres disponibles
For Each P In PT.PivotFields("AA").PivotItems
P.Visible = True
Next P
'on désactive les filtres devant etre inactif
If Not I = 0 Then
For PF = 1 To I
PT.PivotFields("AA").PivotItems(PFN(PF)).Visible = False
Next PF
End If
End With
End If
Next PT

Exit Sub

ShowAll:
I = 0
Resume Next

End Sub
 

Discussions similaires

Réponses
1
Affichages
2 K
Compte Supprimé 979
C
Réponses
7
Affichages
3 K
Compte Supprimé 979
C

Statistiques des forums

Discussions
311 719
Messages
2 081 871
Membres
101 828
dernier inscrit
Did-Pan