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
| Private Sub CommandButton6_Click()
Application.ScreenUpdating = False
Dim x As Range
Dim y As Range
Dim nbrdate As Integer
Dim données As Worksheet
If OptionButton1.Value = True Then
Set données = Sheets("Données")
Else: Set données = Sheets("Données lissées")
End If
'on compte le nbre de ligne
données.Activate
nbrdate = données.Range("B1", [B65000].End(xlUp)).count
'on supprime les anciens graphs
Dim iChtIx As Long, iChtCt As Long
iChtCt = Sheets("Corrélations").ChartObjects.count
If iChtCt <> 0 Then
For iChtIx = 1 To iChtCt
Sheets("Corrélations").ChartObjects(1).Delete
Next
End If
'début de la boucle pour tracer les graphs à partir des colonnes de données i et j.
Dim i, j As Integer
For i = 3 To 10
For j = 3 To 10
If i > j Then
Set x = données.Range(Chr(i + 64) & "2:" & Chr(i + 64) & "" & nbrdate)
Set y = données.Range(Chr(j + 64) & "2:" & Chr(j + 64) & "" & nbrdate)
Sheets("Corrélations").Activate
'graphs
Charts.Add
ActiveChart.ChartType = xlXYScatter
ActiveChart.SetSourceData Source:=données.Range(x, y), PlotBy:=xlColumns
ActiveChart.Location Where:=xlLocationAsObject, Name:="Corrélations"
ActiveChart.HasLegend = False
ActiveChart.HasTitle = False
ActiveChart.PlotArea.Select
With Selection.Border
.ColorIndex = 16
.weight = xlThin
.LineStyle = xlContinuous
End With
With ActiveChart.SeriesCollection(1).Border
.weight = xlThin
.LineStyle = xlAutomatic
End With
'On enlève les séries en trop
Dim nbrSeries As Integer
Dim ser As Integer
nbrSeries = ActiveChart.SeriesCollection.count
MsgBox nbrSeries
If nbrSeries > 1 Then
For ser = 1 To nbrSeries - 1
ActiveChart.SeriesCollection(1).Delete
Next ser
Else
End If
'et on arrange les graphs
With ActiveChart.SeriesCollection(1)
.MarkerBackgroundColorIndex = xlAutomatic
.MarkerForegroundColorIndex = xlAutomatic
.MarkerStyle = xlDiamond
.Smooth = False
.MarkerSize = 3
.Shadow = False
End With
'delimite les bornes des échelles
With ActiveChart.Axes(xlValue)
.MinimumScale = UserForm2.Controls("TextBox" & (i - 2) * 10).Value
.MaximumScale = UserForm2.Controls("TextBox" & (i - 2) * 10 + 1).Value
End With
With ActiveChart.Axes(xlCategory)
.MinimumScale = UserForm2.Controls("TextBox" & (j - 2) * 10).Value
.MaximumScale = UserForm2.Controls("TextBox" & (j - 2) * 10 + 1).Value
End With
ActiveChart.PlotArea.ClearFormats
ActiveChart.Axes(xlValue).MajorGridlines.Delete
ActiveChart.SeriesCollection(1).Select
With Selection.Border
.ColorIndex = 41
.weight = xlThin
.LineStyle = xlContinuous
End With
With Selection
.MarkerBackgroundColorIndex = 41
.MarkerForegroundColorIndex = 41
.MarkerStyle = xlDiamond
.Smooth = False
.MarkerSize = 3
.Shadow = False
End With
With ActiveChart
.Axes(xlCategory, xlPrimary).HasTitle = True
.Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = UserForm2.Controls("TextBox" & j - 2).Value
.Axes(xlValue, xlPrimary).HasTitle = True
.Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = UserForm2.Controls("TextBox" & i - 2).Value
End With
'on nomme le graph
Sheets("Corrélations").ChartObjects(Sheets("Corrélations").ChartObjects.count).Name = i & j
'positionnement des graphs
Dim MyWidth As Long, MyHeight As Long
MyWidth = 250
MyHeight = 150
With ActiveSheet.ChartObjects(i & j)
.Width = MyWidth
.Height = MyHeight
.Left = (j - 3) * MyWidth
.Top = 200 + (i - 3) * MyHeight
End With
' ActiveChart.PlotArea.Select
' Selection.Top = 15
' Selection.Width = 200
' Selection.Left = 5
' Selection.Height = 120
With ActiveChart.ChartArea.Font
.Name = "Calibri"
.Size = 13
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
.Background = xlAutomatic
End With
Else
End If
Next j
Next i
Unload UserForm1
Application.ScreenUpdating = True
End Sub |
Partager