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