Changer les couleurs d'un histogramme empilé à 100% selon le nom des barre en VBA. [Résolu]

[rob1son76]

Bonjour,

Comme le titre l'indique, je souhaitrait modifier les couleurs des barres de mon histogramme selon leur nom (nom des champs).

J'ai un état dans lequel j'ai mis un sous-formulaire avec mon graphique.
0 l'ouverture de mon état j'ai un programme qui récupère les données d'une requête pour les insérer dans une table puis je change l'ordre de mes champs selon leur valeur (décroissante) comme ca je peux avoir un histogramme empilé par valeur décroissante (j'ai pas trouvé d'autre moyen).
Je vous met mon code qui marche (le problème viendra après):

Code :

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
Ms = [Forms]![frm-Maitre-Operation]![sfm_Onglet].[Form]![lmd-mois]
 
sSQL1 = "SELECT Format([Date],""mmmm"") AS Mois,[rqt-G-Eff-5-Groupe].Groupe AS Groupe, Sum([rqt-G-Eff-5-Groupe].Fct) AS Fct, Sum([rqt-G-Eff-5-Groupe].[Temps AP]) AS [Temps AP], Sum([rqt-G-Eff-5-Groupe].[Temps ANP]) AS [Temps ANP], Sum([rqt-G-Eff-5-Groupe].[Temps Dysfonct]) AS [Temps Dysfonct], Sum([rqt-G-Eff-5-Groupe].[Temps desengage]) AS [Temps desengage], Sum([rqt-G-Eff-5-Groupe].Qual) AS Qual"
sSQL1 = sSQL1 & " FROM [rqt-G-Eff-5-Groupe]"
sSQL1 = sSQL1 & " GROUP BY Format([Date],""mmmm""),Groupe"
sSQL1 = sSQL1 & " HAVING (((Format([Date],""mmmm""))='" & Ms & "'))and Groupe='" & Groupe & "';"
 
 
    DoCmd.DeleteObject acQuery, "rqt-G-repart-tps-Groupe-MTD"
    CurrentDb.CreateQueryDef "rqt-G-repart-tps-Groupe-MTD", sSQL1
 
MTDt = DLookup("Mois", "rqt-G-repart-tps-Groupe-MTD")
g = DLookup("Groupe", "rqt-G-repart-tps-Groupe-MTD")
Fct = Round(((Nz(DLookup("Fct", "rqt-G-repart-tps-Groupe-MTD"), 0)) / 60), 2)
AP = Round(((Nz(DLookup("[Temps AP]", "rqt-G-repart-tps-Groupe-MTD"), 0)) / 60), 2)
ANP = Round(((Nz(DLookup("[Temps ANP]", "rqt-G-repart-tps-Groupe-MTD"), 0)) / 60), 2)
Dysfonct = Round(((Nz(DLookup("[Temps Dysfonct]", "rqt-G-repart-tps-Groupe-MTD"), 0)) / 60), 2)
desengage = Round(((Nz(DLookup("[Temps desengage]", "rqt-G-repart-tps-Groupe-MTD"), 0)) / 60), 2)
Qual = Round(((Nz(DLookup("Qual", "rqt-G-repart-tps-Groupe-MTD"), 0)) / 60), 2)
 
 
sSQL = "CREATE TABLE [Graph repart tps MTD Groupe]( [Mois] text(50));"
DoCmd.RunSQL (sSQL)
 
Set a = CurrentDb.QueryDefs("rqt-G-repart-tps-Groupe-MTD")
 
For Each f In a.Fields
 
    n = f.Name
 
If n <> "Mois" And n <> "Groupe" Then
sSQL1 = "ALTER TABLE [Graph repart tps MTD Groupe] ADD [" & n & "] single"
DoCmd.RunSQL (sSQL1)
End If
 
Next
 
    DoCmd.SetWarnings (False)
    'évite l'affichage du message de confirmation d'ajout, supp d'une requete
 
sSQL2 = "INSERT INTO [Graph repart tps MTD Groupe] ([Mois],[Fct], [Temps AP], [Temps ANP],[Temps Dysfonct],[Temps desengage],[Qual] ) VALUES ('" & MTDt & "','" & Fct & "', '" & AP & "','" & ANP & "','" & Dysfonct & "','" & desengage & "','" & Qual & "')"
DoCmd.RunSQL (sSQL2)
 
    DoCmd.SetWarnings (True)
 
db.TableDefs.Refresh
 
Set tbl9 = db.TableDefs("Graph repart tps MTD Groupe")
 
tbl9.Fields("Fct").Name = "Temps Fct"
tbl9.Fields("Qual").Name = "Perte Qualité"
tbl9.Fields("Temps AP").Name = "Perte AP"
tbl9.Fields("Temps ANP").Name = "Perte ANP"
tbl9.Fields("Temps Dysfonct").Name = "Perte Dysfct"
tbl9.Fields("Temps desengage").Name = "Perte desg"
 
Dim t(6) As Long
 
t(0) = Fct
t(1) = AP
t(2) = ANP
t(3) = Dysfonct
t(4) = desengage
t(5) = Qual
 
q0 = 2
q1 = 2
q2 = 2
q3 = 2
q4 = 2
q5 = 2
 
    For i = 1 To 5
If t(0) < t(i) Then
q0 = q0 + 1
End If
    Next
 
    For i = 0 To 5
    If i = 1 Then
    i = 2
    End If
If t(1) < t(i) Then
q1 = q1 + 1
End If
    Next
 
    For i = 0 To 5
    If i = 2 Then
    i = 3
    End If
If t(2) < t(i) Then
q2 = q2 + 1
End If
    Next
 
    For i = 0 To 5
    If i = 3 Then
    i = 4
    End If
If t(3) < t(i) Then
q3 = q3 + 1
End If
    Next
 
    For i = 0 To 5
    If i = 4 Then
    i = 5
    End If
If t(4) < t(i) Then
q4 = q4 + 1
End If
    Next
 
    For i = 0 To 4
If t(5) < t(i) Then
q5 = q5 + 1
End If
    Next
 
 
 
Set fld = tbl9.Fields("Temps Fct")
fld.OrdinalPosition = q0
Set fld = tbl9.Fields("Perte AP")
fld.OrdinalPosition = q1
Set fld = tbl9.Fields("Perte ANP")
fld.OrdinalPosition = q2
Set fld = tbl9.Fields("Perte Dysfct")
fld.OrdinalPosition = q3
Set fld = tbl9.Fields("Perte desg")
fld.OrdinalPosition = q4
Set fld = tbl9.Fields("Perte Qualité")
fld.OrdinalPosition = q5

Bon il n'est pas parfait je le sais mais il fonctionne.

Mon formulaire avec mon graphique a donc pour donnée sources cette table avec les variables triées et est donc en ordre décroissant.
Pour l'instant tout marche.

J'ai ensuite fait un programme pour que selon le nom de la barre (nom de la variable de ma table) une couleur lui soit associé.
Voici mon code:

Code :

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
DoCmd.OpenForm "Graph-repart-tps-MTD-Groupe", , , , , acHidden
 
Set db = CurrentDb
Set Graph = Forms("Graph-repart-tps-MTD-Groupe")(Graphique).Object.Application.Chart
Set oDataS = Graph.Application.DataSheet
 
'On compte le nombre de points (Barre) du graphique
nbcourbe = Graph.SeriesCollection.Count
For noCourbe = 1 To nbcourbe
 
NomBarre = oDataS.Cells(1, noCourbe + 1).Value
 
With Graph.SeriesCollection(NomBarre)
 
    .HasDataLabels = True
 
        With .DataLabels
 
            .Font.Size = 8
            .ShowValue = True
            .ShowSeriesName = False
            .Position = xlLabelPositionCenter
           ' .Position = xlLabelPositionInsideBase
        End With
 
    If NomBarre = "Temps Fct" Then
    .Interior.Color = RGB(204, 255, 204)
 
    ElseIf NomBarre = "Perte desg" Then
    .Interior.Color = RGB(204, 255, 255)
 
    ElseIf NomBarre = "Perte Dysfct" Then
    .Interior.Color = RGB(255, 255, 153)
 
    ElseIf NomBarre = "Perte AP" Then
    .Interior.Color = RGB(204, 153, 255)
 
    ElseIf NomBarre = "Perte ANP" Then
    .Interior.Color = RGB(255, 204, 153)
 
    ElseIf NomBarre = "Perte Qualité" Then
    .Interior.Color = RGB(255, 153, 0)
 
    End If
 
End With
Next

J'ai l'impression que mon programme se fou de moi.
Je m'explique.
Mon état est une ScoreCard d'une usine qui s'ouvre lorsque l'on sélection un groupe.
Lorsque je sélectionne le premier groupe ("Groupe 1") les couleurs correspondent parfaitement selon mon programme.
Mais lorsque j'ouvre la ScoreCard du Groupe 3 le couleur ne correspondent plus au nom car bien sur les variables ne sont pas triés de la même façon.

Les couleurs ne se mettent donc pas en fonction des noms de barres mais en fonction de leur position.

J'ai essayé en changeant les couleurs sur certaine variable est elle se mettent correctement pour le premier groupe mais pas pour le troisième groupe.
Donc mon programme marche quand même pour le premier groupe mais quand je change de groupe les couleurs reste figé selon la position.

Avez vous une idée pour résoudre mon problème svp?

Merci

[rob1son76]

Après avoir essayé plusieur solution je pense que le problème viens du tableau de la feuille de donnée du graphique lorsque l'on fait objetchar puis open.
Il garde en mémoire l'ordre des variables que j'ai mis en construisant le graphique.
Même lorsque je supprime les donnée du tableau ca ne change rien.
Je me demande si, par mon programme, j'arrive a remplir se tableau si les couleurs se mettraient bien.
Mais je ne sais pas manipulé la feuille de donnée par vb.
Quelqu'un sait comment faire?

[rob1son76]

Bon j'ai trouvé la solution.
J'ai enlevé mon code pour les couleurs et mise en forme du graphique de l'évènement du rapport.
A la place j'ai mis ce code la dans l'évènement du formulaire:

Code :

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
Private Sub Form_Load()
Dim Graph   As Graph.Chart
Dim noCourbe As Integer
Dim oDataS  As Object
Dim NomBarre, Mois As String
 
Set db = CurrentDb
Dim fld As DAO.Field
Dim tbl As DAO.TableDef
Set tbl = db.TableDefs("Graph repart tps YTD Groupe")
db.TableDefs.Refresh
 
Set Graph = Forms("Graph-repart-tps-YTD-Groupe")(Graphique).Object.Application.Chart
Set oDataS = Graph.Application.DataSheet
 
'On compte le nombre de points (Barre) du graphique
nbcourbe = Graph.SeriesCollection.Count
For noCourbe = 1 To nbcourbe
 
NomBarre = oDataS.Cells(1, noCourbe + 1).Value
 
    For Each fld In tbl.Fields
 
        For i = 1 To 8
        If fld.OrdinalPosition = i Then
            oDataS.Cells(1, [i]).Value = fld.Name
        End If
        Next i
 
If fld.Name = NomBarre Then
 
With Graph.SeriesCollection(NomBarre)
 
    .HasDataLabels = True
 
        With .DataLabels
 
            .Font.Size = 8
            .ShowValue = True
            .ShowSeriesName = False
            .Position = xlLabelPositionCenter
           ' .Position = xlLabelPositionInsideBase
        End With
 
            If NomBarre = "Temps Fct" Then
            .Interior.Color = RGB(204, 255, 204)
 
            ElseIf NomBarre = "Perte desg" Then
            .Interior.Color = RGB(204, 255, 255)
 
            ElseIf NomBarre = "Perte Dysfct" Then
            .Interior.Color = RGB(255, 255, 153)
 
            ElseIf NomBarre = "Perte AP" Then
            .Interior.Color = RGB(204, 153, 255)
 
            ElseIf NomBarre = "Perte ANP" Then
            .Interior.Color = RGB(255, 204, 153)
 
            ElseIf NomBarre = "Perte Qualité" Then
            .Interior.Color = RGB(255, 153, 0)
 
            End If
 
End With
End If
    Next
Next
End Sub

JE réécris les donnée de la feuille de donnée du graphique pour avoir les nom des champs à la bonne place.
Au préalable j'ai modifié mon premier programme (celui qui trie mes données champs), j'ai mis ma variable:

Code :

1
2
Dim t(6) As Long en 
Dim t(6) as single

Car mes données comporte des virgules et donc je me suis retrouvé avec 2 variables de ma table à la même position et donc avec les même couleur.
D'ailleur si vous pouviez m'aider à améliorer mon programme pour éviter ce genre de chose ca m'aiderai.

Merci.

[paidge]

Bonjour,

Excusez-moi de déterrer le sujet, mais j'ai un léger souci avec la propriété MyChart.SeriesCollection.Count.

En effet, que ce soit sur l'évènement _Open ou _Load, elle me renvoit le nombre de séries de l'affichage précédent.....Du coup, pour la mise en forme de mon graphique ça coince Par exemple si j'ai une série supplémentaire par rapport au dernier affichage du graph, cette dernière ne se met pas en forme suivant mon code

Si quelqu'un avait une piste, je prends !

Bonne soirée

[micniv]

Bonsoir,
essaie sur l'évt Sur MAJ du graphe ( ... _Updated() )

[paidge]

Bonjour,
Merci pour ta réponse. Je connaissais déjà cet évènement. Je voulais éviter mais j'ai fini par cette solution

[rob1son76]

Moi ce que je fait c'est que lors de l'ouverture de mon état j'ouvre, je ferme puis je réouvre mes formulaires avec les graph comme ca j'ai bien les nouvelle données.
Sinon j'utilise un recordset pour avoir les données du graph car comme tu l'a dis par le programme on a les données précédente alors qu'a l'affichage on a bien les bonnes données.