dates françaises qui deviennent des dates US lors de la création d'un TCD

**Patinber** · 24/03/2017, 21h03

Bonsoir,
dans mon fichier Excel je crée un tableau croisé dynamique (TCD) pour monitorer mon activité à l'aide d'une macro VBA.
Je copie une partie des données depuis la feuille A vers la B. Les données sont sur 4 colonnes (du texte, des dates, des dates de révision et des chiffres pour la priorité). Les dates sont bien des dates (lorsque je convertie les colonne en numérique Excel m'indique des nombres du style 45000) et j'ai un format du style 28/07/2017 (et non 07/28/2017).
Après je fais une petite salade pour épurer les données (suppression des cellules comportant des erreurs, des cellules vides). Et enfin je crée mon TCD où:
_ les valeurs sont le nombre des textes
_ les champs de l'axe des abscisses sont la priorité puis la date de révision
A partir de mon TCD je fais un graphique en barre pour connaitre le nombre de fichiers (valeurs de texte) qui doivent être revue par groupe de priorité. La macro procède à une vérification des pivotfield("révision").pivotitems(#) par rapport à la date du jour afin de désélectionner les dates de révision qui sont postérieures à aujourd'hui (sinon le boss a une attaque avant de regarder les dates).
Le problème survient justement sur cette vérification! Excel ne filtre pas grand chose (ou plutôt je n'arrive pas à lui faire faire le travail que je souhaite).
En vérifiant le travail de la macro en mode pas à pas j'ai remarqué que les dates qu'il compare sont au format US (M/J/A). La date d'aujourd'hui est bien au format J/M/A, les dates dans les colonnes des feuilles A et B sont aussi au format J/M/A, les dates que je vois à l'écran dans le TCD sont au format J/M/A mais la valeur ( pivotfield().pivotitems().value ) que la macro lie est au format M/J/A.
Et là je sèche.

Ah oui autre chose qui a peut-être un lien. Mon TCD créé avec la macro n'a pas la même apparence qu'un TCD que je fais à la souris. J'entends par là l'aspect des bordure des cellules du TCD. De plus je n'ai pas de filtre possible dans mon TCD au niveau des dates de révision (à l'exception des "10 premiers"), et les dates ne sont pas regroupées par années, ni par moi. J'ai une liste de l'ensemble des dates triées par ordre chronologique.

Si vous avez besoin de voir mon code je peux le partager. En ce qui concerne le fichier XLSM il faudrait que je fasse un gros ménage ou que je fasse des copies d'écran.

Merci de votre aide.

**78chris** · 24/03/2017, 22h30

Bonjour

Si déjà tu postais le code qui crée le TCD...

**Patinber** · 25/03/2017, 10h37

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
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
Sub metrix_QA()
'
' Création de la feuille pour suivre les dates de révision des QA
'
 
' declaration
'
Dim i As Integer
Dim a As Date, c As Date
'Dim objPivotCache As PivotCaches  fait planter la création du TCD!?
 
' Au lancement de la macro la feuille est purgée
Sheets("metrix QA").Select
Cells.Select
Selection.Delete Shift:=xlUp
 
' Copy des données sources de la feuille SupplyChain
' lors de cette copy on garde les liens mais ce n'est peut-être pas nécessaire
Sheets("SupplyChain").Select
Range("contact[[#Headers],[priorité]]").Select
Range(Selection, Selection.End(xlDown)).Select
Range("contact[[#All],[Quality Agreement]:[priorité]]").Select
Range("contact[[#Headers],[priorité]]").Activate
Selection.Copy
Sheets("metrix QA").Select
Cells(1, 1).Select
ActiveSheet.Paste
' mise au format date des colonnes B & C
Columns("B:C").Select
Selection.NumberFormat = "m/d/yyyy"
' détermination du nbre (i) de ligne à sélectionner
i = 2
Do While Not IsEmpty(Cells(i, 4))
i = i + 1
Loop
i = i - 1
' On crée un nom de table pour cette source sur la feuille de destination
Application.CutCopyMode = False
ActiveWorkbook.Names.Add Name:="mQA", RefersToR1C1:="=metrix QA!R1C1:R" & i & "C4"
ActiveWorkbook.Names("mQA").Comment = _
    "zone source pour la génération du metrix sur les QA"
'
' on epure la table mQA
'
' copie des données de mQA vers d autres colonnes en ne gardant que les valeurs
Cells(1, 4).Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToLeft)).Select
Selection.Copy
Range("F1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
' On crée un nom pour cette nouvelle table
ActiveWorkbook.Names.Add Name:="mmQA", RefersToR1C1:="=metrix QA!R1C6:R" & i & "C9"
ActiveWorkbook.Names("mmQA").Comment = _
    "zone de travail pour générer le metrix des QA"
' suppréssion des entrées dont la date est vide ou lorsqu il y a une cellule avec une erreur
' les cellules avec erreur sont la conséquence d'un QA en rédaction ou signature
i = 1
' suppression de la mise à jour de l ecran afin que ce soit plus fluide
Application.ScreenUpdating = False
Do While Not IsEmpty(Cells(i, 9)) ' boucle sur les cellules PRIORITE de la table mmQA
    If IsError(Cells(i, 8)) = True Then ' si la cellule de REVISION a une erreur alors on supprime la ligne de mmQA
        Range("F" & i & ":I" & i).Select
        Selection.Delete Shift:=xlUp
        i = i - 1
    End If
    If Cells(i, 8) = "" Then ' si la cellule est vide on la supprime de mmQA
        Range("F" & i & ":I" & i).Select
        Selection.Delete Shift:=xlUp
        i = i - 1
    End If
    i = i + 1
Loop
' activation de la mise à jour de l ecran
Application.ScreenUpdating = True
' détermination du nbre (i) de ligne à sélectionner
i = 2
Do While Not IsEmpty(Cells(i, 9))
i = i + 1
Loop
i = i - 1
' suppression des doublons de la table mmQA pour n avoir qu un seul QA par fournisseur
Cells(1, 9).Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToLeft)).Select
ActiveSheet.Range("$F$1:$I$" & i).RemoveDuplicates Columns:=Array(1, 2, 3, 4), _
    Header:=xlYes
' mise au format date des colonnes G & H
    Columns("G:H").Select
    Selection.NumberFormat = "m/d/yyyy"
' Création du tableau croisé dynamique et de son graphique
'
Cells.Select
Selection.Rows.AutoFit
' détermination du nbre (i) de ligne à sélectionner
i = 2
Do While Not IsEmpty(Cells(i, 6))
i = i + 1
Loop
i = i - 1
' le TCD
Set objPivotCache = ActiveWorkbook.PivotCaches.Add( _
    SourceType:=xlDatabase, _
    SourceData:=Worksheets("metrix QA").Range("F1:I" & i))
ActiveSheet.PivotTables.Add _
    PivotCache:=objPivotCache, _
    TableDestination:=Range("K1"), _
    TableName:="bob"
 
With ActiveSheet.PivotTables("bob")
    .AddDataField ActiveSheet.PivotTables("bob").PivotFields("Quality Agreement"), "Nombre de Quality Agreement", xlCount
End With
With ActiveSheet.PivotTables("bob").PivotFields("priorité")
    .Orientation = xlRowField
    .Position = 1
End With
With ActiveSheet.PivotTables("bob").PivotFields("révision")
    .Orientation = xlRowField
    .Position = 2
End With
' ajout du graphique
ActiveSheet.Shapes.AddChart.Select
ActiveChart.ChartType = xlColumnClustered
ActiveChart.SetSourceData Source:=Range("'metrix QA'!$K$1:$M$" & i)
' suppression de la mise à jour de l ecran afin que ce soit plus fluide
Application.ScreenUpdating = False
'
'
'
' IL A TOUJOURS LES DATES EN A SOUS FORME AMERICAINES
'
'
'
' LE TCD NE SEMBLE PAS ETRE AU FORMAT XLS 2010 CAR PAS DE GROUPE PAR DATE
'
'
'
' filtrage des dates sur les QA devant être révisés
For i = 1 To ActiveSheet.PivotTables("bob").PivotFields("révision").PivotItems.Count
    a = ActiveSheet.PivotTables("bob").PivotFields("révision").PivotItems(i).Value
    If a > Date Then
        With ActiveSheet.PivotTables("bob").PivotFields("révision")
            .PivotItems(i).Visible = False
        End With
    End If
Next
' activation de la mise à jour de l ecran
Application.ScreenUpdating = True
' filtrage sur la priorité en supprimant la priorité 0
ActiveSheet.PivotTables("bob").PivotFields("priorité").PivotItems("0").Visible = False
 
End Sub

Et voici un extrait de mes données:

Quality Agreement	approbation	révision	priorité
TA13031867A-02- Sep2013.pdf	01/09/2013	01/09/2016	3
TA........pdf	01/03/2017	01/03/2020	1
TA........pdf	etc	etc	etc