Discussion :

[MrMeeseeks]

Bonjour,

Je débute le VBA depuis quelques jours en temps que stagiaire dans une PME. Mais voila j'avance lentement car je rencontre énormément de bug mais le problème viens du fait que je n'arrive pas à comprendre certains. Il me suffit de recommencer les tableaux du début en ne changeant rien pour que la macro remarche. C'est très étrange et rageant car étant le seul maîtrisant ce langage, on m'a demandé de faire des macros relativement accessible et stable.

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
54
55
56
57
58
59
60
61
62
63
Sub ChangerFiltreDate()
    Dim result As VbMsgBoxResult
    result = MsgBox(Prompt:="Appliquer à toute la page?", Buttons:=vbYesNoCancel, Title:="Choix") 'On affiche un message avec un choix OUI/NON/ANNULER
 
    Dim counttables As Integer
    counttables = ActiveSheet.PivotTables.Count 'Le nombre de tables sur la feuille
 
    Dim tables() As Boolean, curtable As PivotTable
    ReDim tables(counttables)
    Dim j As Integer, i As Integer
    For j = 0 To counttables
        tables(j) = True 'Ce tableau permettra de savoir ce qu'a choisit de faire l'utilisateur pour chaque tableau (initialisation ici)
    Next j
 
 
    If (result = vbNo) Then 'S'il choisit de ne pas appliquer à tout
        For i = 1 To counttables
            Set curtable = ActiveSheet.PivotTables(i)
            result = MsgBox(Prompt:=("Appliquer à " & curtable.Name & "?"), Buttons:=vbYesNo) 'On demande à l'utilisateur de choisir si on applique la date à tous les tableaux
            tables(i) = result = vbYes
        Next i
    ElseIf (result = vbCancel) Then 'Annuler -> sort du programme
        Exit Sub
    End If
    Dim datestart As Date
    Dim dateend As Date
    datestart = CDate(Range("A5").Value) '/!\ Sujet à bug : Pour les deux dates il faut bien mettre les bonnes cases
    dateend = CDate(Range("B5").Value)
    MsgBox datestart & " to " & dateend
 
    Dim k As Integer, nbfalse As Integer, nbtrue As Integer
    nbfalse = 0
    nbtrue = 0
    For k = 1 To counttables 'Pour chacun des tableaux
            If tables(k) = True Then 'Si l'utilisateur a choisi d'appliquer à toutes les tables ou bien si la table a été acceptée précedemment
 
                Dim pt As PivotTable
                Set pt = ActiveSheet.PivotTables(k) 'On met chaque tableau dans la variable pt
 
                Dim field As PivotField, item As Variant, filter As PivotFilter
                For Each field In pt.PivotFields 'Pour chaque field
                    If field.Name Like "*date*" Then 'On ne garde que les champs comportant "date" dans le nom (attention il faut qu'il fasse partie des filtres du tableau)
                        For Each item In field.PivotItems '/!\ Pour une raison inconnue cette ligne est sujet à des bugs si le tableau change d'une cetaine façon (aussi inconue) : Pour chaque valeur dans le champ (field) de dates
                            If IsDate(item.Value) Then '/!\ S'il ne se passe rien ou si ne s'applique pas à tout peut venir de là (pas de chargement): On s'assure qu'on manipule bien des dates (si le programme ne fait rien peut-être que les données sont sous une mauvaise forme)
                            If CDate(item.Value) < datestart Or CDate(item.Value) > dateend Then '/!\ sujet à erreurs : Si la date ne remplit pas la condition on l'enlève
                                field.PivotItems(item.Name).Visible = False 'On cache la date qui ne rentre pas dans les critères
                                nbfalse = nbfalse + 1
                            Else
                                field.PivotItems(item.Name).Visible = True 'Si la date remplit la condition on la montre
                                nbtrue = nbtrue + 1
                            End If
                            End If
                        Next item
                        MsgBox field.PivotItems.Count
                    End If
                Next field
                MsgBox nbfalse & " and true : " & nbtrue
                nbfalse = 0
                nbtrue = 0
                pt.RefreshTable
            End If
        Next k
    End Sub

Voila tout le code mais la partie qui m’intéresse est celle-ci :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
For Each item In field.PivotItems '/!\ Pour une raison inconnue cette ligne est sujet à des bugs si le tableau change d'une cetaine façon (aussi inconue) : Pour chaque valeur dans le champ (field) de dates
                            If IsDate(item.Value) Then '/!\ S'il ne se passe rien ou si ne s'applique pas à tout peut venir de là (pas de chargement): On s'assure qu'on manipule bien des dates (si le programme ne fait rien peut-être que les données sont sous une mauvaise forme)
                            If CDate(item.Value) < datestart Or CDate(item.Value) > dateend Then '/!\ sujet à erreurs : Si la date ne remplit pas la condition on l'enlève
                                field.PivotItems(item.Name).Visible = False 'On cache la date qui ne rentre pas dans les critères
                                nbfalse = nbfalse + 1
                            Else
                                field.PivotItems(item.Name).Visible = True 'Si la date remplit la condition on la montre
                                nbtrue = nbtrue + 1
                            End If
                            End If
                        Next item
                        MsgBox field.PivotItems.Count

Alors que tout fonctionnait très bien (même si un peu lent), tout d'un coup il s'est mit à ne plus reconnaître certaines dates en temps que date (les considérant comme String) et pour les autres il les traite comme toujours en dehors de dateend et datestart donc False.

Je sais que si je recommence le tableau le problème sera réglé mais si je suis incapable de comprendre l'erreur elle risque de réapparaître dans le futur.

Merci d'avance pour votre aide !

Edit: Précisions les mois bien reconnus comme dates mais toujours considéré en dehors de datestart et dateend sont les mois de janvier, mars, septembre, octobre, novembre (en tout 153 jours)
Le reste n'est même pas considéré comme des dates (pourtant le tableau de données a bien la colonne entière considéré comme des dates). Le format de date semble être "14-Janv" alors que je n'utilise nul part ailleurs ce format.

[zoltar_x]

Il existe la fonction CDate pour forcer la conversion en date.

[MrMeeseeks]

Il existe la fonction CDate pour forcer la conversion en date.

Merci de ta réponse rapide, j'ai déjà essayé et je reçois une erreur incomparabilité de type. C'est très étrange étant donné qu'il n'aucun problème à convertir la moitié

[zoltar_x]

Voici un petit code qui te permet de lire tous les types de ton tableau de données.
Il est utile pour suivre les changements de types avant et après traitement ou lorsqu'on importe des données d'un autre système.

Cette macro récupère, à partir de la feuille 1, les données en tableau à partir de la cellule A1 et les stocke dans une table
dynamique redimensionnée à la taille du tableau réel (nombre de lignes et de colonnes identiques au tableau de la feuille de calcul).
Cette table est ensuite déversée dans la feuille 2. Le type (String, Date, Integer, Double ...) de chaque cellule de la table est affiché
dans la feuille 2.

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
Sub lire_type()
 
    Dim table()
    Dim derniere_ligne As Long
    Dim derniere_colonne As Long
    Dim i As Long, j As Long
 
    Worksheets("Feuil1").Select
 
    derniere_ligne = Range("A1").End(xlDown).Row
    derniere_colonne = Range("A1").End(xlToRight).Column
 
    ReDim table(derniere_ligne, derniere_colonne)
 
    For i = 0 To derniere_ligne - 1
    	For j = 0 To derniere_colonne - 1
        	table(i, j) = ActiveSheet.Cells(i + 1, j + 1)
        Next j
    Next i
 
    Worksheets("Feuil2").Select
 
    For i = 0 To derniere_ligne - 1
    	For j = 0 To derniere_colonne - 1
 		ActiveSheet.Cells(i + 1, j + 1) = TypeName(table(i, j))
        Next j
    Next i
 
End Sub

[MrMeeseeks]

Merci c'est en effet intéressant et montre que le problème ne vient pas du tableau de base mais bien soit du tableau croisé dynamique soit de l'interaction entre ce dernier et la macro.
Du coup je reste encore pas mal dans le flou.

[zoltar_x]

Sur ta capture d'écran tu as le type String sur A1 et A2 : normalement il ne doit y avoir qu'un seul intitulé de colonne.
Apparemment tu en as deux. Le Tcd doit planter sur le A2.