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
| Dim i As Long
Dim j As Long
Dim l As Long
Dim u As Long
Dim t As Long
Dim counter As Integer
Dim x As Range
Dim y As Range
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 xlabel As String
Dim ylabel 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
Sheets(l).Activate
For i = 0 To PlotForm.ChoiceList.ListCount - 1
If PlotForm.ChoiceList.Selected(i) = True Then
If PlotForm.ChoiceList.List(i) = Sheets(l).name Then
Set xLoc = ActiveSheet.Range([C14], [D14]).Find(What:=PlotForm.xChoice.Text)
If Not xLoc Is Nothing Then
ActiveSheet.Range([C14], [D14]).Find(What:=PlotForm.xChoice.Text).Select
ActiveCell.Offset(1, 0).Select
Set x = Range(ActiveCell, ActiveCell.End(xlDown))
xlabel = PlotForm.xChoice.Text
xmin = WorksheetFunction.Min(x)
xmax = WorksheetFunction.Max(x)
End If
End If
End If
Next i
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
If PlotForm.EnterTitle.Text <> "" Then
.Chart.ChartTitle.Text = PlotForm.EnterTitle.Text
End If
.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 = xlabel
.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
'If IsEmpty(Range("E1")) Then
' yunit1 = ActiveSheet.Range("E1").End(xlDown).Value
'Else
' yunit1 = ActiveSheet.Range("E1").Value
'End If
'Settings for ordinate axis series and scale
For l = 1 To CptSh
Sheets(l).Activate
For i = 0 To PlotForm.ChoiceList.ListCount - 1
If PlotForm.ChoiceList.Selected(i) = True Then
If PlotForm.ChoiceList.List(i) = Sheets(l).name Then
For t = 0 To PlotForm.TimeList.ListCount - 1
If PlotForm.TimeList.Selected(t) = True Then
Set yLoc = ActiveSheet.Range([E13], [E13].End(xlToRight)).Find(What:=PlotForm.TimeList.List(t), lookat:=xlWhole, LookIn:=xlValues)
If Not yLoc Is Nothing Then
ActiveSheet.Range([E13], [E13].End(xlToRight)).Find(What:=PlotForm.TimeList.List(t), lookat:=xlWhole, LookIn:=xlValues).Select
ylabel = ActiveCell.Offset(1, 0).Value
ActiveCell.Offset(2, 0).Select
Set y = Range(ActiveCell, ActiveCell.End(xlDown))
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" & i + 1).Value = hmin1
'Sheets("MinMax").Range("B" & i + 1).Value = hmax1
With srs
.XValues = x
.Values = y
.name = ylabel & " " & PlotForm.TimeList.List(t) & [L7].Value
End With
'End If
End With
End If
End If
Next t
End If
End If
Next i
Next l |
Problème recherche d'une valeur avec Find
: ça peut servir aux autres
Répondre avec citation
Partager