Discussion :

[hobine]

Bonjour,
Etant débutant en programmation sur VBA, j'ai un problème. c'est pourquoi je me tourne vers vous.
le but est de generer un premier graphique en bâton dont l'axe des abscisse est la date de mutation et l'ordonnée le nombre de personne par date de mutation. i.e nbr pers = f(date de mutation). Et Le deuxième graphe est un camembert dont le pourcentage par service de mutation. J'ai commence à rediger une macro pleine de fautes.
Cette macro illustre d'une manière générale ce que je veux faire. Seulement , elle contient plusieurs erreurs dont je suis incapable de déboguer.
1. La première partie de ma macro consiste à effacer automatiquement la feuille graphe qui a été générée avant. Pour cela j'ai fait des sous routines. il y a bug.
2.Par la suite, je suis aller récupérer et compte le nombre de personnes désirant être mutée par période et par service. (je pense sur cette partie tout va bien. Par contre, je parviens à bien rédiger la matrice me permettant d'avoir mon graphe en bâton pour ce qui est nbre. pers = f(période) et pourcentage de personne voulant être mutée par direction.
Vous trouverez ci dessous ma macro et ses sous-routines, je remercie toute personne de bonne volonté pouvant me sortir de cette galère

==================================================

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
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
Option Explicit
 
Sub CreateChart()
Dim Plage As Range
Dim direction_mutation() As Variant
Dim periode_mutation() As Variant
Dim PossDirection() As Variant, PossPeriode() As Variant
Dim i As Integer, j As Integer, nl As Integer
Dim nligne As Integer
Dim itrimestre As Integer
Dim myexcelfile As String
Dim chemin As String
Dim tableau() As String
Dim tableau2() As Integer
Dim merde As String
 
 
 
chemin = ThisWorkbook.Path
 
myexcelfile = ThisWorkbook.Name
 
' mysheet =
' Set xlBook = Workbooks.Open(chemin & "\" & myexcelfile)
' Set xlSheet = xlBook.Sheets("S1UET1")
 
Charts.Add
 
 
 
 
MsgBox "pouet"
' !!!!!!!!!!!!!! avant de commencer il faut supprimer toutes les feuilles graphiques
'récupération des directions de mutation
 
Set Plage = Range("C2:C" & Range("C65536").End(xlUp).Row + 1)
direction_mutation = Plage.Value
 
'récupération des valeurs possibles des directions en utilisant la fonction qui supprime les doublons
ReDim PossDirection(UBound(direction_mutation, 1))
For i = 1 To UBound(direction_mutation, 1)
PossDirection(i) = direction_mutation(i, 1)
Next i
PossDirection = SupprimerDoublons(PossDirection)
 
 
' récupération des trimestres et années de mutation
Set Plage = Range("B2:B" & Range("B65536").End(xlUp).Row + 1)
periode_mutation = Plage.Value
 
ReDim PossPeriode(UBound(periode_mutation, 1))
For i = 1 To UBound(periode_mutation, 1)
PossPeriode(i) = periode_mutation(i, 1)
Next i
PossPeriode = SupprimerDoublons(PossPeriode)
 
 
ReDim Mutant(UBound(PossDirection), UBound(PossPeriode))
For i = 1 To UBound(PossDirection)
For j = 1 To UBound(PossPeriode)
Mutant(i, j) = 0
Next j
Next i
 
 
For nligne = 1 To UBound(direction_mutation, 1)
 
For i = 1 To UBound(PossDirection)
For j = 1 To UBound(PossPeriode)
If (direction_mutation(nligne, 1) = PossDirection(i)) Then
If (periode_mutation(nligne, 1) = PossPeriode(j)) Then
Mutant(i, j) = Mutant(i, j) + 1
End If
End If
 
 
Next j
Next i
Next nligne
 
 
'graph pour le T1-2012
For i = 1 To UBound(PossPeriode)
If PossPeriode(i) = "T1-2012" Then
itrimestre = i
End If
Next i
MsgBox "so farsogood"
 
 
 
'MsgBox tableau(1)
 
With ActiveChart
.SeriesCollection.NewSeries
.SeriesCollection(1).XValues = periode_mutation() 'Abscisses
.SeriesCollection(1).Values = PossDirection() 'Ordonnées
'Définit le type (Courbe)
.ChartType = xlColumnClustered
End With
 
 
 
 
 
 
 
 
 
 
 
' 1ère étape: on lit la colonne des directions et on détermine les directions possibles
 
' Select the cell in the upper-left corner of the chart.
' Range("c4").Select
' Select the current range of data. This line of code assumes that
' the current region of cells is contiguous - without empty rows
' or columns.
' Selection.CurrentRegion.Select
 
' Assign the address of the selected range of cells to a variable.
' myrange = Selection.Address
 
 
 
 
 
' Application.CutCopyMode = False
 
' This line can best be written by recording a macro, and
' modifying the code generated by the Microsoft Excel Macro
' recorder.
 
' ActiveChart.ChartWizard _
' Source:=Sheets(mysheetname).Range(myrange), _
' Gallery:=xlLine, Format:=4, PlotBy:=xlRows, _
' CategoryLabels:=1, SeriesLabels:=1, HasLegend:=1, _
' Title:="", CategoryTitle:="", _
' ValueTitle:="", ExtraTitle:=""
 
End Function
 
 
Function SupprimerDoublons(tbl()) As Variant()
 
Dim Dico As Object
Dim Cle
Dim T()
Dim i As Long
 
'crée l'objet
 
Set Dico = CreateObject("Scripting.Dictionary")
 
'inscrit les valeurs dans le dictionnaire
'en affectant aussi cette valeur à la clé
'une clé devant être unique, si on ne contrôle pas
'son existance dans la collection, un erreur est générée
For i = 1 To UBound(tbl)
If Dico.Exists(tbl(i)) = False Then
Dico.Add tbl(i), tbl(i)
End If
Next i
 
i = 0
 
'tranfert des valeurs uniques dans un tableau
For Each Cle In Dico.keys
i = i + 1
ReDim Preserve T(1 To i)
T(i) = Cle
Next
 
 
 
 
'passage de ce tableau à la fonction
SupprimerDoublons = T
 
'libère la mémoire
Set Dico = Nothing
 
End Function
 
Sub nettoieFeuilleGraph(fichier As String)
Dim test As Boolean
Dim n As Integer
Dim i As Integer
 
 
 
Application.DisplayAlerts = False
Set xlBook = Workbooks.Open(fichier)
MsgBox Worksheets.Count
n = Worksheets.Count
For i = 1 To n
 
test = WsExist("Graph" + Str(i))
MsgBox test
 
If test = True Then
Worksheets("Graph" + Str(i)).Delete
End If
 
 
 
Next i
Application.DisplayAlerts = True
ActiveWorkbook.Save
 
End Sub
 
Function WsExist(nomFeuil As String) As Boolean
On Error Resume Next
WsExist = Sheets(nomFeuil).Index
End Function

=========================================


Je vous remercie d'avance.

[Daniel.C]

Bonjour,

il y a bug

Oui. Sur quelle ligne; quel est le message d'erreur ?

[hobine]

C'est juste le problème sur ma macro. En effet elle ne signale pas d'erreur (pas un message d'erreurs )mais par contre elle exécute des choses qui n'ont rien à voir avec ce que je veux faire. par, elle ouvre une fenêtre de graphe mais celle-ci est vide. si j'exécute de nouveau le programme, elle ne supprime pas l'ancienne fenêtre alors cela a été écrite.
Le graphe en soit, n'est pas du tout tracé
J'ai illustré mon besoin par un petit exemple que tu pourras voir sur le fichier excel en pièce jointe.

Merci d'avance de vous soucier de mon cas

[Daniel.C]

Tu essaies de faire un graphique avec les variables "Tableau" en abscisse et "Tableau2" en ordonnées. Or, nulle part, tu ne remplis ces variables. Que veux-tu mettre dans ton graphique ? Donne-moi les plages de cellules.

[hobine]

je veux faire un premier graphe en bâton montrant le nombre de personne mutée en fonction la date de mutation.
Le second graphe (un camembert) est la répartition en pourcentage par service de mutation.

[Daniel.C]

Regarde cette macro qui crée le premier graphique. Dis-moi si c'est correct :

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
Sub CreateChart2()
    Dim Plage As Range
    Dim direction_mutation As Variant
    Dim periode_mutation As Variant
    Dim PossDirection As Variant, PossPeriode As Variant
    Dim i As Integer, j As Integer, nl As Integer
    Dim nligne As Integer
    Dim itrimestre As Integer
    Dim myexcelfile As String
    Dim chemin As String
    Dim sh
 
   chemin = ThisWorkbook.Path
   myexcelfile = ThisWorkbook.Name
   For Each sh In Sheets
       If Left(sh.Name, 5) = "GRAPH" Then sh.Delete
   Next sh
 
 
    Charts.Add
 
    Set Plage = Range("C2:C" & Range("C65536").End(xlUp).Row)
    PossDirection = Application.Transpose(Plage.Value)
 
    'récupération des valeurs possibles des directions en utilisant la fonction qui supprime les doublons
    PossDirection = SupprimerDoublons(PossDirection)
 
 
    ' récupération des trimestres et années de mutation
    Set Plage = Range("B2:B" & Range("B65536").End(xlUp).Row)
    PossPeriode = Application.Transpose(Plage.Value)
 
    PossPeriode = SupprimerDoublons(PossPeriode)
    Dim tableau() As Long
    ReDim tableau(1 To UBound(PossPeriode))
    For i = 1 To UBound(PossPeriode)
        tableau(i) = Application.CountIf(Plage, PossPeriode(i))
    Next i
    With ActiveChart
        .SeriesCollection.NewSeries
        .SeriesCollection(1).XValues = PossPeriode  'Abscisses
        .SeriesCollection(1).Values = tableau 'Ordonnées
        'Définit le type (Courbe)
        .ChartType = xlColumnClustered
    End With
 
 End Sub

... et avec le camembert :

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
Sub CreateChart2()
    Dim Plage As Range
    Dim direction_mutation As Variant
    Dim periode_mutation As Variant
    Dim PossDirection As Variant, PossPeriode As Variant
    Dim i As Integer, j As Integer, nl As Integer
    Dim nligne As Integer
    Dim itrimestre As Integer
    Dim myexcelfile As String
    Dim chemin As String
    Dim sh
 
   chemin = ThisWorkbook.Path
   myexcelfile = ThisWorkbook.Name
   Application.DisplayAlerts = False
   For Each sh In Sheets
       If Left(sh.Name, 5) = "Graph" Then sh.Delete
   Next sh
   Application.DisplayAlerts = True
 
    Charts.Add
 
    Set Plage = Range("C2:C" & Range("C65536").End(xlUp).Row)
    PossDirection = Application.Transpose(Plage.Value)
 
    'récupération des valeurs possibles des directions en utilisant la fonction qui supprime les doublons
    PossDirection = SupprimerDoublons(PossDirection)
 
 
    ' récupération des trimestres et années de mutation
    Set Plage = Range("B2:B" & Range("B65536").End(xlUp).Row)
    PossPeriode = Application.Transpose(Plage.Value)
 
    PossPeriode = SupprimerDoublons(PossPeriode)
    Dim tableau() As Double
    ReDim tableau(1 To UBound(PossPeriode))
    For i = 1 To UBound(PossPeriode)
        tableau(i) = Application.CountIf(Plage, PossPeriode(i))
    Next i
    With ActiveChart
        .SeriesCollection.NewSeries
        .SeriesCollection(1).XValues = PossPeriode  'Abscisses
        .SeriesCollection(1).Values = tableau 'Ordonnées
        'Définit le type (Courbe)
        .ChartType = xlColumnClustered
    End With
    ReDim tableau(1 To UBound(PossDirection))
    Set Plage = Plage.Offset(, 1)
    For i = 1 To UBound(PossDirection)
        tableau(i) = Application.CountIf(Plage, PossDirection(i)) / UBound(PossDirection)
    Next i
    Charts.Add
    With ActiveChart
        .SeriesCollection.NewSeries
        .SeriesCollection(1).XValues = PossDirection  'Abscisses
        .SeriesCollection(1).Values = tableau 'Ordonnées
        'Définit le type (Courbe)
        .ChartType = xlPie
    End With
 End Sub