Discussion :

[yanou91]

Bonjour,

Je voudrais savoir si quelqu'un pourrait m'indiquer comment corriger mon code. J'ai un fichier avec lequel je fais TCD qui fonctionne bien. Mais j'ai un champ "Date d'échéance" pour lequel je ne voudrais afficher que les valeurs inférieures à la date d'aujourd'hui.

Je vous place le bout de code qui ne fonctionne pas ou dumoins qui ne plante pas VBA mais qui ne donne pas les résultats attendus :

...

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
Dim pt As PivotItem
For Each pt In ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotFields("Date d'éch.").PivotItems
If (pt.Name < Date) Then
With ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotFields( _
"Date d'éch.").PivotItems(pt.Name).Visible = True
End With
Else:
With ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotFields( _
"Date d'éch.")
.PivotItems(pt.Name).Visible = False
End With
End If
Next pt

...

Ce qui est etrange c'est qu'il décoche certaine date mais qui ne devrait pas et surtout il ne décoche pas celles qu'il devrait. C'est à dire celle dont les valeurs sont des dates inférieures à la date d'aujourd'hui.

Dois-je utiliser la fonction "Today" plutot ? J'ai aussi essayé de mettre date entre guillement mais la rien ne se passe ...

En vous remerciant pour votre aide

[mercatog]

Une proposition

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
19
20
21
22
23
24
25
26
27
28
Sub Realiser()
Dim PVT As PivotTable
 
Application.ScreenUpdating = False
Set PVT = Worksheets("Feuil4").PivotTables("Tableau croisé dynamique1")
'On affiche d'abord tous les pivotitems
Afficher PVT
'On cache les pivotitems ne répondant pas au critère
Afficher PVT, True
Set PVT = Nothing
End Sub
 
Private Sub Afficher(ByVal PVT As PivotTable, Optional Cond As Boolean)
Dim Pt As PivotItem
Dim MaDate As Long
 
For Each Pt In PVT.PivotFields("Date d'éch.").PivotItems
    Pt.Visible = IIf(Cond, Reformer(Pt.Value) <= CLng(Date), True)
Next Pt
 
End Sub
 
Private Function Reformer(ByVal Dte As String) As Long
Dim Tb
 
Tb = Split(Dte, "/")
Reformer = DateSerial(Tb(2), Tb(0), Tb(1))
End Function

[yanou91]

Bonsoir,

Tout d'abord merci d'avoir répondu et proposé des éléments.

La dernière fois j'avais pu utiliser ton aide et tester les soucis ou succès. La je suis embêté car je n'arrive pas à tester ton code. J'ai l'impression qu'il y a plusieurs instructions ou en tout cas VBA me dit qu'il attend un end sub ou alors qu'il ne doit pas avoir d’instruction après le premier End sub ...

J'ai essayé en ajoutant un end sub à la fin ou en supprimant les end sub au milieu de tes codes mais rien à faire y'a toujours quelque chose qui l’empêche d'avancer. du coup je ne saurais même pas dire si ton code fonctionne. Mon manque de maitrise m’empêche même d'adapter ton code pour qu'il fonctionne. je te récris le code plus bas et ai joint un fichier joins pour voir si c'est plus clair pour vous.

Cordialement

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
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
 
Sub Realiser()
Dim PVT As PivotTable
 
Application.ScreenUpdating = False
Set PVT = Worksheets("Feuil1").PivotTables("Tableau croisé dynamique1")
'On affiche d'abord tous les pivotitems
Afficher PVT
'On cache les pivotitems ne répondant pas au critère
Afficher PVT, True
Set PVT = Nothing
End Sub
 
Private Sub Afficher(ByVal PVT As PivotTable, Optional Cond As Boolean)
Dim Pt As PivotItem
Dim MaDate As Long
 
For Each Pt In PVT.PivotFields("Date d'éch.").PivotItems
    Pt.Visible = IIf(Cond, Reformer(Pt.Value) <= CLng(Date), True)
Next Pt
 
End Sub
 
Private Function Reformer(ByVal Dte As String) As Long
Dim Tb
 
Tb = Split(Dte, "/")
Reformer = DateSerial(Tb(2), Tb(0), Tb(1))
End Function
 
Columns("A:A").ColumnWidth = 13.43
    Columns("B:B").ColumnWidth = 39.29
    Columns("D:D").ColumnWidth = 13
    Columns("E:E").ColumnWidth = 13
    Rows("5:5").Select
    ActiveWindow.FreezePanes = True
    ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotSelect _
        "Tiers[All;Total]", xlDataAndLabel, True
    With Selection.Interior
        .ColorIndex = 40
        .Pattern = xlSolid
    End With
    ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotFields( _
        "Somme de Mnt débit").Caption = "Montant débit"
    ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotFields( _
        "Somme de Mnt crédit").Caption = "Montant crédit"
    ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotFields( _
        "Somme de Sld débit").Caption = "Solde débit"
        ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotFields( _
        "Somme de Sld crédit").Caption = "Solde crédit"
        Application.ScreenUpdating = True
 
End Function

Désolé pour cette réponse confuse.

[mercatog]

Voilà, j'ai testé le code sur ton fichier, j'ai une erreur 1004

impossible de définir la propriété visible de la classe pivotitem

Je suis sur Excel 2007.

La raison de l'erreur, incompréhensible.

J'ai supprimé la feuille contenant le TCD et j'ai récrée le TCD tel. J'ai revérifié le code (avec une légère modification), et ça fonctionne sans problème.

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
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
 
Sub Realiser()
Dim PVT As PivotTable
 
Application.ScreenUpdating = False
Set PVT = Worksheets("Feuil1").PivotTables(1)
'On affiche d'abord tous les pivotitems
Afficher PVT
'On cache les pivotitems ne répondant pas au critère
Afficher PVT, True
Set PVT = Nothing
End Sub
 
Private Sub Afficher(ByVal PVT As PivotTable, Optional Cond As Boolean)
Dim Pt As PivotItem
Dim MaDate As Long
 
For Each Pt In PVT.PivotFields("Date d'éch.").PivotItems
    If Cond Then
        Pt.Visible = Reformer(Pt.Value) <= CLng(Date)
    Else
        Pt.Visible = True
    End If
Next Pt
End Sub
 
Private Function Reformer(ByVal Dte As String) As Long
Dim Tb
 
If InStr(Dte, "/") Then
    Tb = Split(Dte, "/")
    Reformer = DateSerial(Tb(2), Tb(0), Tb(1))
End If
End Function

[yanou91]

Merci beaucoup pour votre réponse. Il est vrai qu'à la maison j'ai 2007 alors qu'en ce moment au boulot j'ai 2003. Mais en general ca ne gene pas les macro jsuque là.

Votre code fonctionne, il va au bout et ne plante pas. En revanche je vois que comparé au fichier de base quasi toutes les dates sont décochées. Ce qui voudraient dire que trè peu sont en retard (echéances dépassées Vs date du jour).

Ce qui ne vas pas car etant le 30/01/2013 toutes les dates de 2012 jusque la devrait être visibles car "en retard, echéances dépassées ou ateinte". et toutes celles à partir du 31/01/2013 devraient être décochées.

Ou alors c'est moi qui n'a pas été clair dans mon ennoncé initial ?

Je vais aussi tester à la maison pour voir si avec 2007 les résultats sont différents.

Cordialement

oops, sur 2007 la macro bloque à :

Pt.Visible = True (dans la private sub) ...

Erreur 1004 : Impossible de definir la propriété visible de la classe PivotItems

Entre temps j'essaie de faire des changement pour voir si ca peut passer ^^.

[mercatog]

Voilà, j'ai testé le code sur ton fichier, j'ai une erreur 1004
Je suis sur Excel 2007.

La raison de l'erreur, incompréhensible.

J'ai supprimé la feuille contenant le TCD et j'ai récrée le TCD tel. J'ai revérifié le code (avec une légère modification), et ça fonctionne sans problème.

[yanou91]

Bonsoir,

Je débute en VBA et il est vrai que j'ai du mal à comprendre votre solution et la mettre en œuvre correctement dans mon code pour qu'elle fonctionne (que ca soit en 2003 ou 2007 d'ailleurs).

J'ai donc utilisé un stratagème moins "classe" que le votre mais que j'arrive à faire fonctionner. Dans la base de données du TCD j'ai créé une colonne ou j'ai placé "Échéance dépassée". et je colle la formule si Excel aujourd'hui qui compare les dates d'échéance à la date du jour. Puis j'inclus le champs dans le TCD puis fait un tri. Cela donne bien ce que je veux voir.

Je vous remercie car j'ai pu faire cela (et coller la formule dans la colonne) grâce à une technique que vous m'aviez donné lors d'une précédente aide. Voici les parcelles de codes correspondantes.

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
19
20
21
22
23
24
25
26
27
28
29
30
31
 
...
With Worksheets(1)
.Columns(2).Insert
LastLig2 = .Cells(.Rows.Count, 1).End(xlUp).Row
 Tb5 = .Range("B1:B" & LastLig2)
 Tb5(1, 1) = "Echéance dépassée"
For i = 2 To LastLig2
     'C'est ici que je colle le formule si qui comapre la date echéance en colonne "K" avec la date d'aujourd'hui. Ca fonctionne ainsi
    Tb5(i, 1) = "=IF(R[0]C[+9]<=TODAY(),""OUI"",""NON"")"
    Next i
    .Range("B1:B" & LastLig2) = Tb5
End With
 
...
 
Dim pt11 As PivotItem
    For Each pt11 In ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotFields("Echéance dépassée").PivotItems
'Ici, je demande à VBA de selectionner la valeur "oui" dans le champ "Echéance dépassée" du TCD.
    If (pt11.Name = "OUI") Then
    With ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotFields( _
    "Echéance dépassée").PivotItems(pt11.Name).Visible = True
    End With
    Else:
    With ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotFields( _
    "Echéance dépassée")
    .PivotItems(pt11.Name).Visible = False
    End With
    End If
    Next pt11
...

Bonne soirée

[mercatog]

Voilà une très belle approche. je vous mets un +1 mérité.

Encore faut il savoir que les TCD entre Excel 2003 et Excel 2007 ont connu un changement.

[yanou91]

Lequel SVP ? Désolé la curiosité me pousse ...

Car il est vrai que sur une autre macro, le TCD marchait aussi bien en 2003 qu'en 2007 mais j'imagine qu'il y a des subtilités.

Bonne soirée.

[mercatog]

Par exemple le filtre chronologique (sur les dates)