VBA-Filtre TCD ne fonctionne pas

Bonjour le forum,

Le problème semble relativement simple mais je ne comprend pas d'où vient mon erreur. Un peu d'aide me serai donc utile.

Ce que je souhaite faire :

Filtrer un TcD en fonction d'un mois et d'une année. J'ai 2 filtres, un pour le mois et un pour l'année. L'année et le mois souhaité son indiqués dans 2 cellules, qui contiennent une formule (le mois et l'année doivent être dynamique).

Mon problème :

Mon code VBA est assez basique, il filtre bien le champ Années mais pas le champ mois?

J'ai beau me creuser la tête je ne sais pas d'où vient mon erreur.

Edit1 : Je vous mets la macro au cas où le problème vous sauterai au yeux.

Sub essai1()
Dim Annee As String, Fmois As String

Annee = Sheets("Feuil1").Range("J1")
Fmois = Sheets("Feuil1").Range("K1")

        Sheets("Feuil1").PivotTables("Tableau croisé dynamique3").PivotFields("Mois").ClearAllFilters
        Sheets("Feuil1").PivotTables("Tableau croisé dynamique3").PivotFields("Années").ClearAllFilters
        Sheets("Feuil1").PivotTables("Tableau croisé dynamique3").PivotFields("Mois").CurrentPage = Fmois
        Sheets("Feuil1").PivotTables("Tableau croisé dynamique3").PivotFields("Années").CurrentPage = Annee

End Sub

PS : J'ai déjà chercher sur les différents forum, mais rien n'as pu résoudre ce problème (ou alors j'ai regardé au mauvais endroit)

Ci-joint, un fichier représentatif de mon problème :

bonjour

sans VBA

avec une colonne de pointage (mettre sous forme de tableau permet une meilleure gestion de données et un report auto des formules et extensions des plages nommées)

Bonjour jmd,

Merci pour la réponse.

J'ai besoin de conserver la mise en forme précédente.

Je m'explique :

L'action que je souhaite effectuer s'inscrit dans un projet plus important. De ce fichier j'ai, dans un feuille, une synthèse de ma base de données (qui est elle même alimenté par USF). Sur cette synthèse j'affiche le nombre de valeur à 0 (la colonne valeur me sert à compter les occurrences de la ligne sous certaines conditions), pour chaque activité. J'affiche également les activité qui n'ont pas de valeur à 0, dans la synthèse.

Dans cette synthèse, en double-cliquant sur le nombre de valeur à 0 une macro vient recherché l'activité concerné dans le TcD et utilise l'option "ShowDetail" afin d'ouvrir une page avec les lignes concernés.

Malheureusement, je ne peux pas communiquer le fichier dont je parle précédemment.

De plus, je ne comprends pas bien l'ajout que tu as effectué. En modulant les valeur les valeurs du TcD ne changes pas et la colonne "Pointage" reste à 0.

Peux-tu m'éclairer ?

Bonjour,

Un début de réponse.

Option Explicit

Public Sub filterPivotDate()
Dim pt As PivotTable
Dim pf As PivotField
Dim pi As PivotItem
Dim startDate As Date, endDate As Date
Dim dtValue As Date
Dim iMonth As Integer

    Set pt = Me.PivotTables(1)
    Set pf = pt.PivotFields("Date")

    iMonth = Month(Date) - 2
    startDate = DateSerial(Year(Date), iMonth, 1)
    endDate = WorksheetFunction.EoMonth(startDate, 0)

    With pf
        .ClearAllFilters
        .EnableMultiplePageItems = True
        '.ShowAllItems = True
    End With

    For Each pi In pf.PivotItems
        dtValue = DateSerial(Split(pi.Value, "/")(2), Split(pi.Value, "/")(0), Split(pi.Value, "/")(1))
        On Error Resume Next
        If dtValue < startDate Or dtValue > endDate Then
            pi.Visible = False
        Else
            pi.Visible = True
        End If
        On Error GoTo 0
    Next pi

    Set pf = Nothing: Set pt = Nothing

End Sub

Bonjour Jean-Eric,

Merci de te réponse!

Excuse moi de ne pas t'avoir répondu plus tôt, je n'était pas disponible ce week-end.

Je test ta solution ce matin et reviens vers toi.

Edit :

Une erreur s'affiche à la ligne ci dessous :

  dtValue = DateSerial(Split(pi.Value, "/")(2), Split(pi.Value, "/")(0), Split(pi.Value, "/")(1)) 

--> Erreur '9' : L'indice n'appartient pas à la sélection

Pourtant dtValue renvoie bien une date, au bon format.

Edit 2 :

Mon problème est résolu. J'ai contourné le problème :

J'utilise comme filtre l'année et l'activité, le mois en étiquette de ligne. J'utilise ensuite la propriété "ShowDetail" en prenant pour référence le mois et en ajoutant la propriété "Offset".

Mon code (si cela peut aider certains, ou si vous voyez une amélioration possible) :

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim Ecible As Range, splage As Range, cel As Range, Mcible As Range, M As String, per As String, Annee As String, D As String

Annee = ActiveSheet.Range("B3")
M = Month(Date) - 2
Set Ecible = Sheets("Listes").Columns("X").Find(what:=M, LookIn:=xlValues, lookat:=xlWhole)
Set Mcible = Ecible.Offset(0, 1)
Set splage = Sheets("Listes").Columns("V").Find(what:=Mcible, LookIn:=xlValues, lookat:=xlWhole)

Application.ScreenUpdating = False
For i = 14 To 23
    If Not Application.Intersect(Target, Range("J" & i)) Is Nothing Then
    per = Sheets("SUIVI").Range("G" & i)

        Sheets("Listes").PivotTables("Tableau croisé dynamique2").PivotFields("Années").ClearAllFilters
        Sheets("Listes").PivotTables("Tableau croisé dynamique2").PivotFields("Périmètre").ClearAllFilters
        Sheets("Listes").PivotTables("Tableau croisé dynamique2").PivotFields("Années").CurrentPage = Annee
        Sheets("Listes").PivotTables("Tableau croisé dynamique2").PivotFields("Périmètre").CurrentPage = per

        If splage Is Nothing Then
        Msg = "Aucun retards n'est comptabilisé pour " & Ecible
        Else
        Set cel = splage.Offset(0, 1)
        cel.ShowDetail = True
        End If

        ActiveSheet.Name = per & " " & Format(Now, "dd-mm-yyyy")
    End If
Next

End Sub

Merci pour votre aide!

Bonjour,

Essaie ainsi :

Public Sub filterPivotDate2()
Dim pt As PivotTable
Dim pf As PivotField
Dim pi As PivotItem
Dim dtValue As Date
Dim lngStart As Long, lngEnd As Long
Dim lngValue As Long
Dim iMonth As Integer

    Set pt = Me.PivotTables(1)
    Set pf = pt.PivotFields("Date")

    iMonth = Month(Date) - 2
    lngStart = CLng(DateSerial(Year(Date), iMonth, 1))
    lngEnd = CLng(WorksheetFunction.EoMonth(lngStart, 0))

    With pf
        .ClearAllFilters
        .EnableMultiplePageItems = True
        '.ShowAllItems = True
    End With

    For Each pi In pf.PivotItems
        dtValue = DateSerial(Split(pi.Value, "/")(2), Split(pi.Value, "/")(0), Split(pi.Value, "/")(1))
        lngValue = CLng(dtValue)
        On Error Resume Next
        If lngValue < lngStart Or lngValue > lngEnd Then
            pi.Visible = False
        Else
            pi.Visible = True
        End If
        On Error GoTo 0
    Next pi

    Set pf = Nothing: Set pt = Nothing

End Sub

Bonjour Jean-Eric,

A nouveau, merci pour ton aide. Mon problème étant résolu (en louvoyant) tu n'ai pas obliger de poursuivre

Le problème reste cependant inchangé avec ton code (sur la même ligne), je ne comprends pas réellement pourquoi...