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
| Option Explicit ' Chart avec deux series de valeurs
Public Const colorFillBlue = 34
Public Const colorFillPaleBlue = 37
Public Const colorFillGray = 48
' Création d'un graphique à deux courbes
Sub CurveNew()
Dim chartObj As ChartObject, rngAbscisse As Range, rngOrdonnee1 As Range, rngOrdonnee2 As Range
Application.ScreenUpdating = False
Set rngAbscisse = Range("A2:A6")
Set rngOrdonnee1 = Range("B2:B6")
Set rngOrdonnee2 = Range("C2:C6")
Set chartObj = ActiveSheet.ChartObjects.Add(Left:=50, Width:=500, Top:=100, Height:=300)
With chartObj.Chart
.ChartType = xlXYScatterSmoothNoMarkers ' Déclarer le type en premier
CleanSeriesColl chartObj.Chart ' dans le cas où il y a des series par défaut
CurveSeries chartObj.Chart, rngAbscisse, rngOrdonnee1, rngOrdonnee2, _
"Ordonnée 1", "Ordonnée 2"
.HasTitle = True
.ChartTitle.Characters.Text = "Chart Title"
.HasDataTable = False
.PlotArea.Interior.ColorIndex = 0 'White
CurveAxis chartObj.Chart, "Category (X) axis", "Value (Y) axis"
' .HasLegend = False
.HasLegend = True
.Legend.Position = xlLegendPositionBottom
' .Legend.LegendEntries(1).Delete ' Pour effacer 'Ordonnée 1' de la légende
End With
Application.ScreenUpdating = True
End Sub
' Définition des deux séries de données
Sub CurveSeries(chartThis As Chart, rngX As Range, rngY1 As Range, rngY2 As Range, _
ByVal strTitleY1 As String, ByVal strTitleY2 As String)
Dim serie1 As Series, serie2 As Series
With chartThis.SeriesCollection
Set serie1 = .NewSeries
With serie1
.Values = rngY1
.XValues = rngX
.Name = strTitleY1
.Border.Weight = xlMedium
End With
Set serie2 = .NewSeries
With serie2
.Values = rngY2
.XValues = rngX
.Name = strTitleY2
.Border.Weight = xlMedium
End With
End With
End Sub
' Axes du graphique
Sub CurveAxis(chartThis As Chart, ByVal strTitleX As String, ByVal strTitleY As String)
Dim axisAbscisse As Axis, axisOrdonnee As Axis
With chartThis
Set axisOrdonnee = .Axes(xlValue, xlPrimary)
With axisOrdonnee
.MaximumScale = 10
.MinimumScale = 1
.HasTitle = True
.AxisTitle.Characters.Text = strTitleX
.MajorGridlines.Border.LineStyle = xlDot
.MajorGridlines.Border.ColorIndex = colorFillGray
.MajorTickMark = xlTickMarkCross
End With
Set axisAbscisse = .Axes(xlCategory, xlPrimary)
With axisAbscisse
.HasTitle = True
.AxisTitle.Characters.Text = strTitleY
.MajorTickMark = xlTickMarkInside
.TickLabelPosition = xlTickLabelPositionLow
.MinorTickMark = xlTickMarkNone
.TickLabels.Orientation = xlHorizontal
End With
End With
End Sub
' Effacer la collection des séries dans le graphique
Private Sub CleanSeriesColl(chartThis As Chart)
With chartThis
On Error Resume Next
Do
.SeriesCollection(1).Delete
If Err.Number > 0 Then Exit Do
Loop Until False
On Error GoTo 0
End With
End Sub
' Effacer toutes les courbes
Sub CurveDelete()
With ActiveSheet.ChartObjects
While .Count > 0
CleanSeriesColl .Item(1).Chart
.Item(1).Delete
Wend
End With
End Sub |
Problèmes pour tracer des graphiques avec une macro
Répondre avec citation
Envoyé par Margoooot
ci-dessous.
Partager