Rafraîchir des graphes tracés à l'aide d'une macro

**Babar09** · 22/06/2017, 15h22

Bonjour à tous,

J'ai écrit un code VBA qui permet à l'utilisateur de tracer des graphiques. J'aimerais que ces graphiques puissent être rafraîchis automatiquement lorsqu'on change des valeurs dans le tableau d'origine (comme c'est le cas lorsqu'on trace le graphique manuellement avec Excel). J'ai beau modifier les tableaux d'origine, le graphe ne change pas... Est-ce parce que celui-ci est tracé à partir d'un code VBA ? Avez-vous des idées ? Merci !

**halaster08** · 22/06/2017, 15h49

Bonjour,

J'ai déjà fait pleins de graphique via vba et je n'ai jamais eu ce soucis, peux-tu montrer ton code

**Babar09** · 22/06/2017, 17h01

Le problème est que le code est assez long... Dans un UserForm, l'utilisateur choisi abscisses et ordonnées qui sont des concaténations de nom_feuille et entête_colonne, le code cherche ensuite dans la feuille en question le nom de colonne en question et trace la colonne...

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
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
 
    Dim i As Long
    Dim j As Long
    Dim l As Long
    Dim u As Long
    Dim counter As Integer
    Dim x As Variant
    Dim y As Variant
    Dim Cell As Range
    Dim cht As Object
    Dim srs As Series
    Dim rng As Range
    Dim c As Integer
    Dim co
    Dim num As Integer
    Dim Cpt As Integer
    Dim CptSh As Integer
    Dim srscnt As Integer
    Dim xLoc As Range
    Dim yLoc As Range
    Dim xmin As Variant
    Dim xmax As Variant
    Dim hmin1 As Variant
    Dim hmax1 As Variant
    Dim ymin1 As Variant
    Dim ymax1 As Variant
    Dim hmin2 As Variant
    Dim hmax2 As Variant
    Dim ymin2 As Variant
    Dim ymax2 As Variant
    Dim xunit As String
    Dim yunit As String
    Dim yunit1 As String
    Dim yunit2 As String
    Dim shminmax As Worksheet
 
        CptSh = ActiveWorkbook.Sheets.Count
 
'Opens a new sheet to find axis extrema and units
    Set shminmax = Sheets.Add(After:=Sheets(Sheets.Count))
    shminmax.Name = "MinMax"
 
'Selects column of selected choice for abscissa axis
    For l = 1 To CptSh
        If Split(PlotForm.xChoice.Text, "_")(0) = Sheets(l).Name Then
            Sheets(l).Activate
            Set xLoc = ActiveSheet.Cells.Find(What:=Split(PlotForm.xChoice.Text, "_")(1))
                If Not xLoc Is Nothing Then
                    ActiveSheet.Cells.Find(What:=Split(PlotForm.xChoice.Text, "_")(1)).Select
                    xunit = ActiveCell.Offset(1, 0).Value
                    ActiveCell.Offset(2, 0).Select
                    x = Range(ActiveCell, ActiveCell.End(xlDown)).Value
                    xmin = WorksheetFunction.Min(x)
                    xmax = WorksheetFunction.Max(x)
                End If
        End If
    Next l
 
'Plots all y against x
    Set cht = ActiveWorkbook.ActiveSheet.ChartObjects.Add(Left:=350, Width:=400, Top:=30, Height:=275)
 
    'Chart settings
        With cht
 
    .Chart.ChartType = xlXYScatterLinesNoMarkers
 
            'Chart Title
                .Chart.HasTitle = True
                .Chart.ChartTitle.Text = PlotForm.EnterTitle.Text
                .Chart.ChartTitle.Font.Name = "Arial"
                .Chart.ChartTitle.Font.FontStyle = "Bold"
                .Chart.ChartTitle.Font.Size = 10
 
            'Chart Legend
                .Chart.Legend.Position = xlBottom
                .Chart.Legend.AutoScaleFont = False
                .Chart.Legend.Font.Name = "Arial"
                .Chart.Legend.Font.Size = 7
 
            'Chart Axis
                'Abscissa Axis
                .Chart.Axes(xlCategory).HasTitle = True
                .Chart.Axes(xlCategory).AxisTitle.Font.Size = 8
                .Chart.Axes(xlCategory).AxisTitle.Text = PlotForm.Enterxlabel.Text & " " & xunit
                .Chart.Axes(xlCategory).MinimumScale = xmin
                .Chart.Axes(xlCategory).MaximumScale = xmax
 
                'Ordinate Axis
                For l = 1 To CptSh
                Sheets(l).Activate
                    For j = 0 To PlotForm.yChoice.ListCount - 1
                        If PlotForm.yChoice.Selected(j) = True Then
                            If Split(PlotForm.yChoice.List(j), "_")(0) = Sheets(l).Name Then
                                Set yLoc = ActiveSheet.Cells.Find(What:=Split(PlotForm.yChoice.List(j), "_")(1))
                                    If Not yLoc Is Nothing Then
                                        ActiveSheet.Cells.Find(What:=Split(PlotForm.yChoice.List(j), "_")(1)).Select
                                        yunit = ActiveCell.Offset(1, 0).Value
                                        Sheets("MinMax").Range("E" & j + 1).Value = yunit
                                    End If
                            End If
                        End If
                    Next j
                Next l
 
                Sheets("MinMax").Activate
                yunit1 = ActiveSheet.Range("E1").End(xlDown).Value
 
                'Settings for ordinate axis series and scale
                For l = 1 To CptSh
                Sheets(l).Activate
                    For j = 0 To PlotForm.yChoice.ListCount - 1
                        If PlotForm.yChoice.Selected(j) = True Then
                            If Split(PlotForm.yChoice.List(j), "_")(0) = Sheets(l).Name Then
                                Set yLoc = ActiveSheet.Cells.Find(What:=Split(PlotForm.yChoice.List(j), "_")(1))
                                    If Not yLoc Is Nothing Then
                                        ActiveSheet.Cells.Find(What:=Split(PlotForm.yChoice.List(j), "_")(1)).Select
                                        yunit2 = ActiveCell.Offset(1, 0).Value
                                        ActiveCell.Offset(2, 0).Select
                                        y = Range(ActiveCell, ActiveCell.End(xlDown)).Value
 
                                        srscnt = .Chart.SeriesCollection.Count
 
                                        With cht
                                            If yunit1 <> yunit2 Then
                                                Set srs = .Chart.SeriesCollection.NewSeries
                                                srscnt = srscnt + 1
                                                    .Chart.SeriesCollection(srscnt).Select
                                                    .Chart.SeriesCollection(srscnt).AxisGroup = 2
                                                    .Chart.Axes(xlValue, xlSecondary).Select
                                                        hmin2 = WorksheetFunction.Min(y)
                                                        hmax2 = WorksheetFunction.Max(y)
                                                        Sheets("MinMax").Range("C" & j + 1).Value = hmin2
                                                        Sheets("MinMax").Range("D" & j + 1).Value = hmax2
                                                With srs
                                                    .XValues = x
                                                    .Values = y
                                                    .Name = PlotForm.yChoice.List(j)
                                                End With
                                            Else
                                                Set srs = .Chart.SeriesCollection.NewSeries
                                                srscnt = srscnt + 1
                                                    hmin1 = WorksheetFunction.Min(y)
                                                    hmax1 = WorksheetFunction.Max(y)
                                                    Sheets("MinMax").Range("A" & j + 1).Value = hmin1
                                                    Sheets("MinMax").Range("B" & j + 1).Value = hmax1
                                                With srs
                                                    .XValues = x
                                                    .Values = y
                                                    .Name = PlotForm.yChoice.List(j)
                                                End With
                                            End If
                                        End With
 
                                    End If
                            End If
                        End If
                    Next j
                Next l
 
                ymin1 = WorksheetFunction.Min(Sheets("MinMax").Range("A1").EntireColumn)
                ymax1 = WorksheetFunction.Max(Sheets("MinMax").Range("B1").EntireColumn)
                ymin2 = WorksheetFunction.Min(Sheets("MinMax").Range("C1").EntireColumn)
                ymax2 = WorksheetFunction.Max(Sheets("MinMax").Range("D1").EntireColumn)
 
                Sheets("MinMax").Activate
                yunit1 = ActiveSheet.Range("E1").End(xlDown).Value
 
                'Settings for ordinate axis
                    'y left axis
                        .Chart.Axes(xlValue).HasTitle = True
                        .Chart.Axes(xlValue).AxisTitle.Font.Size = 8
                        .Chart.Axes(xlValue).AxisTitle.Text = PlotForm.Enteryleftlabel.Text & " " & yunit1
                        .Chart.Axes(xlValue).MinimumScale = ymin1
                        .Chart.Axes(xlValue).MaximumScale = ymax1
 
                    'y right axis
                    If .Chart.HasAxis(xlValue, xlSecondary) = True Then
                        .Chart.Axes(xlValue, xlSecondary).Select
                        .Chart.Axes(xlValue, xlSecondary).HasTitle = True
                        .Chart.Axes(xlValue, xlSecondary).AxisTitle.Font.Size = 8
                        .Chart.Axes(xlValue, xlSecondary).AxisTitle.Text = PlotForm.Enteryrightlabel.Text & " " & yunit2
                        .Chart.Axes(xlValue, xlSecondary).MinimumScale = ymin2
                        .Chart.Axes(xlValue, xlSecondary).MaximumScale = ymax2
                    End If
 
 
            'Deletes the sheet for axis extrema and units
                With Application
                    .ScreenUpdating = False
                    .DisplayAlerts = False
                End With
                Sheets("MinMax").Delete
                Application.ScreenUpdating = True
                Application.DisplayAlerts = True
 
            'Settings for the grid
                With .Chart.Axes(xlCategory)
                .TickLabels.Font.Size = 8
                .HasMajorGridlines = True
                    With .MajorGridlines.Border
                    .ColorIndex = 16
                    .Weight = xlHairline
                    .LineStyle = xlContinuous
                    End With
                    .HasMinorGridlines = True
                        With .MinorGridlines.Border
                        .ColorIndex = 15
                        .Weight = xlHairline
                        .LineStyle = xlDot
                        End With
                .MajorTickMark = xlOutside
                .MinorTickMark = xlOutside
                End With
 
                With .Chart.Axes(xlValue)
                .TickLabels.Font.Size = 8
                .HasMajorGridlines = True
                    With .MajorGridlines.Border
                    .ColorIndex = 16
                    .Weight = xlHairline
                    .LineStyle = xlContinuous
                    End With
                    .HasMinorGridlines = True
                        With .MinorGridlines.Border
                        .ColorIndex = 15
                        .Weight = xlHairline
                        .LineStyle = xlDot
                        End With
                End With
 
        End With
 
Unload PlotForm

Good luck...

**Babar09** · 23/06/2017, 16h03

Je pense savoir d'où vient l'erreur. Lorsque je clique droit sur mes graphes et "Select data", je me rends compte que les series ne sont pas des Range, mais la liste des valeurs contenues dans les cases, séparées par des ";".

J'ai tenté dans le code précédent de changer ma ligne de code

Code :

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

y = Range(ActiveCell, ActiveCell.End(xlDown)).Value

par

Code :

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

y = Range(ActiveCell, ActiveCell.End(xlDown))

Mais le problème persiste... Avez-vous une idée pour remplacer le ".Value" pour n'obtenir que le Range dans mes series ?

**halaster08** · 25/06/2017, 09h42

Envoyé par Babar09

Avez-vous une idée pour remplacer le ".Value" pour n'obtenir que le Range dans mes series ?

dim y as range plutôt que variant, et ne pas mettre le .value.

**Marc-L** · 25/06/2017, 19h55

Bonjour,

et ne pas oublier l'instruction Set pour les variables de type objet !

___________________________________________________________________________________________________________

Je suis Paris, London, Manchester, Egypte, Stockholm, Istanbul, Berlin, Nice, Bruxelles, Charlie, …

**Babar09** · 26/06/2017, 09h57

Un grand merci à tous les deux, ca marche maintenant parfaitement !!

Rafraîchir des graphes tracés à l'aide d'une macro

Macros et VBA Excel

Discussions similaires

Partager

Partager