Bonjour,
J'utilise le code suivant pour des filtres de tableau croisé dynamique :
Ce code me permet d'appliquer automatique un filtre dans mes 2 tableaux croisés dynamiques à partir d'une liste de choix dans la feuille "Config".
Ce code fonctionne parfaitement mais je l'ai récupéré sur un site et je pense qu'il peut être allégé.
Est-ce que vous pourriez y jeter un œil, en vous remerciant.
J'utilise le code suivant pour des filtres de tableau croisé dynamique :
Code:
Option Explicit
Option Base 1
Sub Configuration()
Dim pivitemName As PivotItem, i As Integer
Dim aUsersArray() As String, intPos As Integer
On Error Resume Next
ReDim aUsersArray(118)
i = 1
Sheets("Config").Activate
Cells(1, 1).Select
Do While Not IsEmpty(ActiveCell.Value)
aUsersArray(i) = ActiveCell.Value
i = i + 1
ActiveCell.Offset(1, 0).Select
Loop
Sheets("TCD").Activate
For Each pivitemName In ActiveSheet.PivotTables("TCD1").PivotFields("Etat").PivotItems
intPos = SearchValueInArrayByPosition(aUsersArray, pivitemName.Value)
If intPos = 0 Then
pivitemName.Visible = False
Else
pivitemName.Visible = True
End If
Next
On Error Resume Next
ReDim aUsersArray(20)
i = 1
Sheets("Config").Activate
Cells(1, 2).Select
Do While Not IsEmpty(ActiveCell.Value)
aUsersArray(i) = ActiveCell.Value
i = i + 1
ActiveCell.Offset(1, 0).Select
Loop
Sheets("TCD").Activate
For Each pivitemName In ActiveSheet.PivotTables("TCD2").PivotFields("Assigné").PivotItems
intPos = SearchValueInArrayByPosition(aUsersArray, pivitemName.Value)
If intPos = 0 Then
pivitemName.Visible = False
Else
pivitemName.Visible = True
End If
Next
End Sub
Function SearchValueInArrayByPosition(aArray, varValue) As Variant
Dim varPos As Variant, i As Integer
varPos = Application.Match(varValue, aArray, 0)
If IsError(varPos) Then
SearchValueInArrayByPosition = 0
Else
SearchValueInArrayByPosition = varPos
End If
End Function
Ce code me permet d'appliquer automatique un filtre dans mes 2 tableaux croisés dynamiques à partir d'une liste de choix dans la feuille "Config".
Ce code fonctionne parfaitement mais je l'ai récupéré sur un site et je pense qu'il peut être allégé.
Est-ce que vous pourriez y jeter un œil, en vous remerciant.
Pièces jointes
Dernière édition: