VBA EXCEL - créer graphe dynamiquement

Version imprimable

Bonjour,

J'ai un problème pour créer dynamiquement un graphique sur une feuille selon un tableau de valeurs à 3 colonnes.

Axe X Séries Valeurs (Y)
Time [h] RAT MEAN
0.25 Rat 397 1040
0.5 Rat 397 3570
1 Rat 397 4230
2 Rat 397 3360
4 Rat 397 322
6 Rat 397 BLQ
0.25 Rat 398 3270
0.5 Rat 398 3590
1 Rat 398 3620
2 Rat 398 3180
4 Rat 398 1650
6 Rat 398 464
0.25 Rat 399 2480
0.5 Rat 399 3780
1 Rat 399 4100
2 Rat 399 5160
4 Rat 399 4270
6 Rat 399 480

Pour chaque série (Rat), j'ai une valeur (Mean) donnée en fonction du temps (Time).

Voila le code où Atitle est le nom de mon graphique, Asheet le nom de la feuille sur lequel je l'insère, Arange la plage de données.

Exemple d'appel: Call CreateChart("Graphique1", "Feuille1", "A6") me crée un tableau sur la feuille sélectionnée.
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 Sub CreateChart(Atitle As String, Asheet As String, Arange As String) '--------------------------------------------------------------------------------------- ' Procedure : CreateChart ' Author : ' Date : 09/06/2008 ' Purpose : '--------------------------------------------------------------------------------------- ' On Error GoTo CreateChart_Error Dim mychart As ChartObject Dim myrange As Range Dim mysheetname As String Charts.Add With ActiveChart ActiveChart.Name = Atitle ActiveChart.ChartType = xlLineMarkers ActiveChart.SetSourceData Source:=Sheets(Asheet).Range(Arange), PlotBy:= _ xlColumns ActiveChart.Location Where:=xlLocationAsObject, Name:=Asheet ActiveChart.HasLegend = True ActiveChart.AutoScaling = False End With ActiveChart.SeriesCollection.NewSeries ActiveChart.SeriesCollection(1).XValues = Range(Arange).Value ActiveChart.SeriesCollection(1).Values = "=" & Asheet & "!R13C4:R18C4" ActiveChart.SeriesCollection(1).Name = Range(Arange).Offset(1, 1) ActiveChart.SeriesCollection(2).Values = "=" & Asheet & "!R19C4:R24C4" ActiveChart.SeriesCollection(2).Name = Range(Arange).Offset(7, 1) 'ActiveChart.SeriesCollection(3).Values = "=" & Asheet & "!R25C4:R30C4" 'ActiveChart.SeriesCollection(3).Name = Range(Arange).Offset(13, 1) ActiveChart.Legend.Select Selection.Position = xlBottom ' On Error GoTo 0 Exit Sub CreateChart_Error: MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure CreateChart of Module Module6" ' End Sub
Je souhaite optimiser les choses suivantes:
1) J'ai un message d'erreur sur la 3ème série.
2) Je souhaite créer une boucle car la taille de chaque série n'est pas fixe.
3) Je voudrais remplacer les références RxCx par des Cells() (ou au pire Range)
4) Déterminer la position x,y de mon graphe

Citation:

1) J'ai un message d'erreur sur la 3ème série.

là comme ça je vois pas pourquoi ?

Citation:

2) Je souhaite créer une boucle car la taille de chaque série n'est pas fixe.

Pourquoi une boucle ? Quels seraient les critères de cette boucle ?

Citation:

3) Je voudrais remplacer les références RxCx par des Cells() (ou au pire Range)

R(x) = Row(x) --> ligne(x)
C(y) = Column(y) --> colonne (y)
Cells(x, y) --> R14C3 = Cells(14, 3) = Range("C14")

Citation:

4) Déterminer la position x,y de mon graphe
Code:

1 2 3 4 With ActiveSheet.Shapes("Graphique 1") .Top = 50 '<-- position verticale .Left = 200 '<-- position horizontale End With
Petite remarque concernant l'utilisation du With...End With
Code:

1 2 3 4 5 6 7 8 9 With ActiveChart .Name = Atitle .ChartType = xlLineMarkers .SetSourceData Source:=Sheets(Asheet).Range(Arange), PlotBy:= _ xlColumns .Location Where:=xlLocationAsObject, Name:=Asheet .HasLegend = True .AutoScaling = False End With
L'intérêt d'utiliser le With...End With est de ne plus devoir répéter l'objet (ici ActiveChart) à chaque ligne

16/06/2008, 09h40
neo2k2
Merci Fring pour ta réponse. :yaisse2:

Alors pour compléter ma question et rebondir sur tes réflexions avisées:
1) j'ai eu un message d'erreur, que je laisse le code tel quel ou que j'essaie de faire une simple boucle "for"...
2) en parlant de la boucle, les éléments de ma série ne sont pas systématiquement fixes, là, j'ai 3 séries de 6 valeurs mais je peux très bien n'avoir que 2 séries de 9... donc il faudrait que je fasse une détection sur l'ensemble des valeurs(x) = RAT 39x, par exemple, pour trouver la répétition. Peux-tu m'aider? 8-)
3) ok, c'est ce qu'il me semblait mais chez moi ça plante si j'utiliser un Cells() ou un Range(), j'ai un message du genre "Bad reference or object with Cells"
4) mdr, je pensais que cela n'existait pas... :oops:
5) oui, c'est plus propre...

Encore merci, j'attends de tes nouvelles pour la suite.
Citation:
Envoyé par fring

Code:

1 2 3 R(x) = Row(x) --> ligne(x) C(y) = Column(y) --> colonne (y) Cells(x, y) --> R14C3 = Cells(14, 3) = Range("C14")
Petite précision, comment remplacer proprement:

Code:

ActiveChart.SeriesCollection(x).Values = "=Feuille1!R25C4:R30C4"

par quelque chose de dynamique, genre:

Code:

ActiveChart.SeriesCollection(x).Values = "=" & Asheet & "!" & Range(cell_begin &":"& cell_end)

où cell_begin et cell_end seraient des variables du début et de la fin de ma plage de données...

A mon sens ça devrait ressembler à quelques chose de ce genre

Code:

1
2
3
4
5
6
Dim cell_begin As String, cell_end As String
 
cell_begin = Range("A1").Addres 'ou Cells(1, 1).Address
cell_end = Range("A10").Address 'ou Cells(10, 1).Address
 
ActiveChart.SeriesCollection(x).Values = "=" & Asheet & "!" & cell_begin & ":" & cell_end & """

bonjour,

si tu essaye ça, ça dis quoi?

:o)

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
Sub CreateChart(Atitle As String, Asheet As String, Arange As Range)
'---------------------------------------------------------------------------------------
' Procedure : CreateChart
' Author    :
' Date      : 09/06/2008
' Purpose   :
'---------------------------------------------------------------------------------------
'
    On Error GoTo CreateChart_Error
        Dim mychart As ChartObject
        Dim myrange As Range
        Dim mysheetname As String
 
        Charts.Add
 
        With ActiveChart
            ActiveChart.Name = Atitle
            ActiveChart.ChartType = xlLineMarkers
            ActiveChart.SetSourceData Source:=Arange, PlotBy:= _
            xlColumns
            ActiveChart.Location Where:=xlLocationAsObject, Name:=Asheet
            ActiveChart.HasLegend = True
            ActiveChart.AutoScaling = False
        End With
 
        ActiveChart.SeriesCollection(1).XValues = Arange
 
        ActiveChart.Legend.Select
        Selection.Position = xlBottom
        '
    On Error GoTo 0
        Exit Sub
 
CreateChart_Error:
 
    MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure CreateChart of Module Module6"
'
End Sub

Alors, profitant de l'aide de Fring, j'ai avancé à grands pas :D et voici le code presque terminé :

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
Option Explicit
 
Sub CreateChart(Atitle As String, Asheet As String, Arange As String)
'---------------------------------------------------------------------------------------
' Procedure : CreateChart
' Author    : 
' Date      : 09/06/2008
' Purpose   :
'---------------------------------------------------------------------------------------
'
    On Error GoTo CreateChart_Error
        '
        Dim achart As String, acell As String, xcell As String
        Dim i As Long, n As Long, num As Long
        Dim k As String
        Charts.Add
        '
        With ActiveChart
            .Name = Atitle
            .ChartType = xlLineMarkers
            .SetSourceData Source:=Sheets(Asheet).Range(Arange), PlotBy:= _
            xlColumns
            .Location Where:=xlLocationAsObject, Name:=Asheet
        End With
        '
        ActiveChart.SeriesCollection.NewSeries
        '
        acell = Range("C12").Address
        xcell = Range("C12").Offset(0, -1).Address
        If Len(acell) > 4 Then
            num = Right(Range(acell).Offset(1, 0).Address, 2)
        Else
            num = Right(Range(acell).Offset(1, 0).Address, 1)
        End If
        '
        n = 1
        k = Range("C65536").End(xlUp).Address
        If Len(k) > 4 Then
            k = Right(k, 2)
        Else
            k = Right(k, 1)
        End If
        For i = 13 To k
            If Range("C" & i).Value = Range("C" & i + 1).Value Then
                n = n + 1
            Else
                n = n
                Exit For
            End If
        Next i
        '
        acell = Range(xcell).Offset(1, 2).Address
        '
        ActiveChart.SeriesCollection(1).XValues = Range(xcell).Value
        ActiveChart.SeriesCollection(1).Values = Sheets(Asheet).Range("D" & num & ":D" & num + n - 1)
        ActiveChart.SeriesCollection(1).Name = Range("C" & num).Value
        ActiveChart.SeriesCollection(2).Values = Sheets(Asheet).Range("D" & num + n & ":D" & num + 2 * n - 1)
        ActiveChart.SeriesCollection(2).Name = Range("C" & num + n).Value
        '
        ' pourquoi est-ce que ca plante ICI ??? --->
        '
        'ActiveChart.SeriesCollection(3).Values = Sheets(Asheet).Range("D" & num + 2 * n & ":D" & num + 3 * n - 1)
        'ActiveChart.SeriesCollection(3).Name = Range("C" & num + 2 * n).Value
        '
        With ActiveChart
            .Axes(xlCategory, xlPrimary).HasTitle = True
            .Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = Range("C12")
            .Axes(xlValue, xlPrimary).HasTitle = True
            .Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = Range("D12")
        End With
        With ActiveChart.PageSetup
            .ChartSize = xlFitToPage
            .PrintQuality = 600
            .CenterHorizontally = False
            .CenterVertically = False
            .Orientation = xlLandscape
            .Zoom = 100
        End With
        achart = Right(ActiveChart.Name, Len(ActiveChart.Name) - (Len(Asheet) + 1))
        With ActiveSheet.Shapes(achart)
            .Top = 400
            .Left = 0
            .ScaleWidth 0.75, msoFalse, msoScaleFromTopLeft
            .ScaleHeight 0.75, msoFalse, msoScaleFromTopLeft
        End With
        Range("A1").Select
        '
    On Error GoTo 0
        Exit Sub
 
CreateChart_Error:
 
    MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure CreateChart of Module Module6"
'
End Sub

Est-ce que l'un de vous arrive à m'expliquer pourquoi ça plante quand je dé-commente la ligne de la série 3?

J'ai même testé en commentant la série 1 et en renommant la 3 en 1 --> ça ne plante plus... Il doit donc y avoir un léger problème dans la définition de la plage de données ou quelque chose du genre...

Sinon, il faudra que je nettoye un peu le code à la fin... :?

Citation:

Envoyé par mayekeul

bonjour,

si tu essaye ça, ça dis quoi?

:o)

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
Sub CreateChart(Atitle As String, Asheet As String, Arange As Range)
'---------------------------------------------------------------------------------------
' Procedure : CreateChart
' Author    :
' Date      : 09/06/2008
' Purpose   :
'---------------------------------------------------------------------------------------
'
    On Error GoTo CreateChart_Error
        Dim mychart As ChartObject
        Dim myrange As Range
        Dim mysheetname As String
 
        Charts.Add
 
        With ActiveChart
            ActiveChart.Name = Atitle
            ActiveChart.ChartType = xlLineMarkers
            ActiveChart.SetSourceData Source:=Arange, PlotBy:= _
            xlColumns
            ActiveChart.Location Where:=xlLocationAsObject, Name:=Asheet
            ActiveChart.HasLegend = True
            ActiveChart.AutoScaling = False
        End With
 
        ActiveChart.SeriesCollection(1).XValues = Arange
 
        ActiveChart.Legend.Select
        Selection.Position = xlBottom
        '
    On Error GoTo 0
        Exit Sub
 
CreateChart_Error:
 
    MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure CreateChart of Module Module6"
'
End Sub

Bonjour, j'ai une erreur type 1004 "Cannont create Chart scaling" ou un message de cette teneur...

16/06/2008, 13h58
mayekeul

Citation:

Bonjour, j'ai une erreur type 1004 "Cannont create Chart scaling" ou un message de cette teneur...

c'est vague, tu peux m'en dire plus?

quelle ligne génere cette erreur par exemple

au fait, tu as bien vu cette modif?

Code:

Sub CreateChart(Atitle As String, Asheet As String, Arange As Range)

Oui, j'avais noté la différence avec le Range.

Voici le code de l'erreur:

Citation:

Error 1004 (Method 'Autoscaling' of object '_Chart' failed) in procedure CreateChart of Module Module 6

En désactivant la ligne contenant ActiveChart.AutoScaling = False, ça joue sans problème.

Mon soucis n'est plus dans la création de la première série (ta procédure est bonne) mais bien dans le fait que pour un nombre de séries > 2 ça plante.

Je viens donc d'adapter mon code selon les informations que j'ai trouvées dans ta procédure:

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
Sub CreateChart(Atitle As String, Asheet As String, Arange As Range)
'---------------------------------------------------------------------------------------
' Procedure : CreateChart
' Author    :
' Date      : 09/06/2008
' Purpose   :
'---------------------------------------------------------------------------------------
'
    On Error GoTo CreateChart_Error
        '
        Dim achart As String, acell As String, xcell As String
        Dim i As Long, n As Long, num As Long
        Dim k As String
        Charts.Add
        '
        With ActiveChart
            .Name = Atitle
            .ChartType = xlLineMarkers
            .SetSourceData Source:=Arange, PlotBy:= _
            xlColumns
            .Location Where:=xlLocationAsObject, Name:=Asheet
        End With
        '
        ActiveChart.SeriesCollection.NewSeries
        '
        acell = Range("C12").Address
        xcell = Range("C12").Offset(0, -1).Address
        If Len(acell) > 4 Then
            num = Right(Range(acell).Offset(1, 0).Address, 2)
        Else
            num = Right(Range(acell).Offset(1, 0).Address, 1)
        End If
        '
        n = 1
        k = Range("C65536").End(xlUp).Address
        If Len(k) > 4 Then
            k = Right(k, 2)
        Else
            k = Right(k, 1)
        End If
        For i = 13 To k
            If Range("C" & i).Value = Range("C" & i + 1).Value Then
                n = n + 1
            Else
                n = n
                Exit For
            End If
        Next i
        '
        acell = Range(xcell).Offset(1, 2).Address
        '
        ActiveChart.SeriesCollection(1).XValues = Range(Range(xcell).Offset(1, 0).Address & ":" & Range(xcell).Offset(n, 0).Address).Value
        ActiveChart.SeriesCollection(1).Values = Sheets(Asheet).Range("D" & num & ":D" & num + n - 1)
        ActiveChart.SeriesCollection(1).Name = Range("C" & num).Value
        ActiveChart.SeriesCollection(2).Values = Sheets(Asheet).Range("D" & num + n & ":D" & num + 2 * n - 1)
        ActiveChart.SeriesCollection(2).Name = Range("C" & num + n).Value
        'ActiveChart.SeriesCollection(3).Values = Sheets(Asheet).Range("D" & num + 2 * n & ":D" & num + 3 * n - 1)
        'ActiveChart.SeriesCollection(3).Name = Range("C" & num + 2 * n).Value
        '
        With ActiveChart
            .Axes(xlCategory, xlPrimary).HasTitle = True
            .Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = Range(xcell).Value
            .Axes(xlValue, xlPrimary).HasTitle = True
            .Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = Range(Range(xcell).Offset(0, 2).Address).Value
        End With
        With ActiveChart.PageSetup
            .ChartSize = xlFitToPage
            .PrintQuality = 600
            .CenterHorizontally = False
            .CenterVertically = False
            .Orientation = xlLandscape
            .Zoom = 100
        End With
        achart = Right(ActiveChart.Name, Len(ActiveChart.Name) - (Len(Asheet) + 1))
        With ActiveSheet.Shapes(achart)
            .Top = 400
            .Left = 2
            .ScaleWidth 0.77, msoFalse, msoScaleFromTopLeft
            .ScaleHeight 0.77, msoFalse, msoScaleFromTopLeft
        End With
        Range("A1").Select
        '
    On Error GoTo 0
        Exit Sub
 
CreateChart_Error:
 
    MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure CreateChart of Module Module6"
'
End Sub

16/06/2008, 14h55
mayekeul

en fait, dans ton code de départ cela ne fonctionnais pas car la troisième seriescollection ,n'existait pas
tu en a rajouté une deuxième mais pas une troisième
16/06/2008, 15h06
neo2k2

Citation:

Envoyé par mayekeul

en fait, dans ton code de départ cela ne fonctionnais pas car la troisième seriescollection ,n'existait pas
tu en a rajouté une deuxième mais pas une troisième

Refais-le moi le ? 8O Je ne suis pas sûr d'avoir suivi... Si tu parles du fait que ma série est commentée dans le code, oui, sinon je suis largué... :(
16/06/2008, 15h13
mayekeul

si une fois cette ligne

Code:

ActiveChart.SeriesCollection.NewSeries

2 series ( tu en a déjà défini une dans la création du chart je présume)

mais pas trois....

tu dois la reprendre pour en avoir une troisième

une autre méthode

Code:

Activechart.SeriesCollection.Add source:=Worksheets("sheet1").Range("a1:a19")

En effet, en attendant que tu postes la réponse, ça m'a titillé et je me suis demandé le sens de

Code:

ActiveChart.SeriesCollection.NewSeries

Bien joué !!! :king: Et merci beaucoup à vous 2! :yaisse2:

Je poste le code complet mais il me reste encore à effectuer une boucle pour le nombre de séries et ce sera parfait (pour mon usage tout du moins).

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
Option Explicit
 
Sub CreateChart(Atitle As String, Asheet As String, Arange As Range)
'---------------------------------------------------------------------------------------
' Procedure : CreateChart
' Author    : neo2k2
' Date      : 09/06/2008
' Purpose   :
'---------------------------------------------------------------------------------------
'
    On Error GoTo CreateChart_Error
        '
        Dim achart As String, acell As String, xcell As String
        Dim i As Long, n As Long, num As Long
        Dim k As String
        Charts.Add
        '
        With ActiveChart
            .Name = Atitle
            .ChartType = xlLineMarkers
            .SetSourceData Source:=Arange, PlotBy:= _
            xlColumns
            .Location Where:=xlLocationAsObject, Name:=Asheet
        End With
        '
        ActiveChart.SeriesCollection.NewSeries
        ActiveChart.SeriesCollection.NewSeries
        '
        acell = Range("C12").Address
        xcell = Range("C12").Offset(0, -1).Address
        If Len(acell) > 4 Then
            num = Right(Range(acell).Offset(1, 0).Address, 2)
        Else
            num = Right(Range(acell).Offset(1, 0).Address, 1)
        End If
        '
        n = 1
        k = Range("C65536").End(xlUp).Address
        If Len(k) > 4 Then
            k = Right(k, 2)
        Else
            k = Right(k, 1)
        End If
        For i = 13 To k
            If Range("C" & i).Value = Range("C" & i + 1).Value Then
                n = n + 1
            Else
                n = n
                Exit For
            End If
        Next i
        '
        acell = Range(xcell).Offset(1, 2).Address
        '
        ActiveChart.SeriesCollection(1).XValues = Range(Range(xcell).Offset(1, 0).Address & ":" & Range(xcell).Offset(n, 0).Address).Value
        ActiveChart.SeriesCollection(1).Values = Sheets(Asheet).Range("D" & num & ":D" & num + n - 1)
        ActiveChart.SeriesCollection(1).Name = Range("C" & num).Value
        ActiveChart.SeriesCollection(2).Values = Sheets(Asheet).Range("D" & num + n & ":D" & num + 2 * n - 1)
        ActiveChart.SeriesCollection(2).Name = Range("C" & num + n).Value
        ActiveChart.SeriesCollection(3).Values = Sheets(Asheet).Range("D" & num + 2 * n & ":D" & num + 3 * n - 1)
        ActiveChart.SeriesCollection(3).Name = Range("C" & num + 2 * n).Value
        '
        With ActiveChart
            .Axes(xlCategory, xlPrimary).HasTitle = True
            .Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = Range(xcell).Value
            .Axes(xlValue, xlPrimary).HasTitle = True
            .Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = Range(Range(xcell).Offset(0, 2).Address).Value
        End With
        With ActiveChart.PageSetup
            .ChartSize = xlFitToPage
            .PrintQuality = 600
            .CenterHorizontally = False
            .CenterVertically = False
            .Orientation = xlLandscape
            .Zoom = 100
        End With
        achart = Right(ActiveChart.Name, Len(ActiveChart.Name) - (Len(Asheet) + 1))
        With ActiveSheet.Shapes(achart)
            .Top = 400
            .Left = 2
            .ScaleWidth 0.77, msoFalse, msoScaleFromTopLeft
            .ScaleHeight 0.77, msoFalse, msoScaleFromTopLeft
        End With
        Range("A1").Select
        '
    On Error GoTo 0
        Exit Sub
 
CreateChart_Error:
 
    MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure CreateChart of Module Module6"
'
End Sub