Discussion :

[Alain Desabrais]

Bonjour,

J'ai un petit problème à soumettre, je cherche à mettre en place une routine qui permettra à un utilisateur de saisir une date pour qu'ensuite un filtre soit appliqué avec la valeur de cette saisie au niveau d'un Tableau Croisé Dynamique.
La routine pour la saisie d'une date fonctionne, mais celle qui permet d'appliquer un filtre par rapport à cette date au niveau du tableau croisé dynamique ne fonctionne pas correctement.

Voici les deux routines en question :

Routine pour saisir une date:

Module 3

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Sub EntrerValeurPourSaisieDate()
 
Dim message, title, defaultValue As String Dim myValue As String ' Set prompt.
message = "Entrer une date correspondant au lundi de la semaine recherchée au format année-mois-jour"
' Set title.
title = "Saisie de la semaine"
defaultValue = "2017-01-02"   ' Set default value.
 
' Display message, title, and default value.
myValue = InputBox(message, title, defaultValue) ' If user has clicked Cancel, set myValue to defaultValue If myValue = "" Then myValue = defaultValue
 
Range("G2").Value = myValue
 
 
End Sub

Routine pour mettre à jour le filtre du tableau croisé dynamique selon la date obtenue avec l'autre routine


Module 2 VBA

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Sub TCD_Filtre_Date_AD_En_Travail()
    Application.ScreenUpdating = True
    On Error Resume Next
    Range("A2").Select
    ActiveSheet.PivotTables("Tableau croisé dynamique2").ClearAllFilters
    ActiveSheet.PivotTables("Tableau croisé dynamique2").Refresh
    [A1] = ActiveSheet.PivotTables(2).Name
 
    With ActiveSheet.PivotTables(Range("A1").Text).PivotFields("Semaine")
 
        For i = G2 To ActiveSheet.PivotTables(Range("A1").Text).PivotFields("Directeur").PivotItems.Count '- 1
            If Range("G2").Value = .PivotItems(i).Value Then .PivotItems([G2].Value).Visible = True Else .PivotItems(i).Visible = False
 
        Next
    End With
 
    Application.ScreenUpdating = True
End Sub

Vous trouverez ci-joint une copie du fichier avec lequel j'effectue les essais : Copie de alain TEST21-09-2017.xlsm

Merci d'avance pour votre aide!

Alain

[Invité]

Bonjour,

J'ai modifié votre fichier pour y mettre réellement le numéro de semaine dans votre onglet Feuil2. Et j'ai créé les deux segments Semaine et Directeur comme dans le vidage d'écran ci-dessous :

Un clic sur chacun des items des segments met jour le TCD. Dans cette solution, je n'utilise pas VBA.

Pièce jointe 315561

[Alain Desabrais]

Merci M. Kergresse, j'aime la solution que vous me proposez!