'Créer des formes pour le graphique Radar'Le graphique se nomme "Mon Radar"
'Les séries se nomment Objectif, Limite, Début de cycle, Fin de cycle
Sub Rdr_Shapes()
Dim Wsh As Worksheet, Chrt As Chart, Shp As Shape
Dim i As Byte, j As Byte, k As Integer, back As Byte, Start As Byte, Début As Byte
Dim Alpha0 As Double, AlphaN As Double, nb_Séries As Byte, n As Byte
Dim AmplitudeAxe As Double, MinAxe As Double, LEch As Double
Dim X0 As Double, Y0 As Double, X1 As Double, Y2 As Double
Dim tb1, tb2, xy1(), xy2(), comp(), V1(1 To 3), V2(1 To 3), Delta As Double
Set Wsh = Feuil1
Set Chrt = Wsh.ChartObjects("Mon_Radar").Chart
Alpha0 = -[Pi()] 'Orientation de la 1ère branche
With Chrt
nb_Séries = Chrt.SeriesCollection.Count 'nbre de séries
'valeurs des séries
tb1 = Chrt.SeriesCollection("Objectif").Values
tb2 = Chrt.SeriesCollection("Limite").Values
n = UBound(tb1) 'nbre de branches du radar
AlphaN = -2 * [Pi()] / n 'mesure de l'angle entre de branche
AmplitudeAxe = .Axes(xlValue).MaximumScale - .Axes(xlValue).MinimumScale 'longueur représentée sur l'axe
MinAxe = .Axes(xlValue).MinimumScale 'valeur minimale de l'axe
With .PlotArea
LEch = .InsideHeight / 2 / AmplitudeAxe 'taille d'une unité
'position de l'origine du radar
X0 = .InsideTop + .InsideHeight / 2
Y0 = .InsideLeft + .InsideWidth / 2
End With
'suppression des anciennes formes
For Each Shp In .Shapes
Shp.Delete
Next
End With
'forme de la zone de confort
If WorksheetFunction.Count(tb1) < n Or WorksheetFunction.Count(tb2) < n Then GoTo Cycle
ReDim xy1(0 To n - 1, 0 To 1): ReDim xy2(0 To n - 1, 0 To 1)
'début de la 1ère limite
xy1(0, 0) = Y0 + (tb1(1) - MinAxe) * LEch * Sin(Alpha0)
xy1(0, 1) = X0 + (tb1(1) - MinAxe) * LEch * Cos(Alpha0)
With Chrt.Shapes.BuildFreeform(msoEditingAuto, xy1(0, 0), xy1(0, 1))
For i = 1 To n - 1
xy1(i, 0) = Y0 + (tb1(i + 1) - MinAxe) * LEch * Sin(Alpha0 + i * AlphaN)
xy1(i, 1) = X0 + (tb1(i + 1) - MinAxe) * LEch * Cos(Alpha0 + i * AlphaN)
.AddNodes msoSegmentLine, msoEditingAuto, xy1(i, 0), xy1(i, 1)
Next i
'fermeture de la 1ère limite
.AddNodes msoSegmentLine, msoEditingAuto, xy1(0, 0), xy1(0, 1)
'début de la 2ème limite
xy2(0, 0) = Y0 + (tb2(1) - MinAxe) * LEch * Sin(Alpha0)
xy2(0, 1) = X0 + (tb2(1) - MinAxe) * LEch * Cos(Alpha0)
.AddNodes msoSegmentLine, msoEditingAuto, xy2(0, 0), xy2(0, 1)
For i = 1 To n - 1
xy2(i, 0) = Y0 + (tb2(i + 1) - MinAxe) * LEch * Sin(Alpha0 + i * AlphaN)
xy2(i, 1) = X0 + (tb2(i + 1) - MinAxe) * LEch * Cos(Alpha0 + i * AlphaN)
.AddNodes msoSegmentLine, msoEditingAuto, xy2(i, 0), xy2(i, 1)
Next i
'fermeture de la 2ème limite
.AddNodes msoSegmentLine, msoEditingAuto, xy2(0, 0), xy2(0, 1)
'fin de la contruction
With .ConvertToShape
.Name = "Zone Confort"
With .Fill
.ForeColor.RGB = RGB(0, 255, 0)
.Transparency = 0.2
.Solid
End With
.Line.Visible = msoFalse
End With
End With
Cycle:
'forme de la vie du cycle (globale)
tb1 = Chrt.SeriesCollection("Début de cycle").Values
tb2 = Chrt.SeriesCollection("Fin de cycle").Values
If WorksheetFunction.Count(tb1) < n Or WorksheetFunction.Count(tb2) < n Then Exit Sub
'début de la 1ère limite
xy1(0, 0) = Y0 + (tb1(1) - MinAxe) * LEch * Sin(Alpha0)
xy1(0, 1) = X0 + (tb1(1) - MinAxe) * LEch * Cos(Alpha0)
With Chrt.Shapes.BuildFreeform(msoEditingAuto, xy1(0, 0), xy1(0, 1))
For i = 1 To n - 1
xy1(i, 0) = Y0 + (tb1(i + 1) - MinAxe) * LEch * Sin(Alpha0 + i * AlphaN)
xy1(i, 1) = X0 + (tb1(i + 1) - MinAxe) * LEch * Cos(Alpha0 + i * AlphaN)
.AddNodes msoSegmentLine, msoEditingAuto, xy1(i, 0), xy1(i, 1)
Next i
'fermeture de la 1ère limite
.AddNodes msoSegmentLine, msoEditingAuto, xy1(0, 0), xy1(0, 1)
'début de la 2ème limite
xy2(0, 0) = Y0 + (tb2(1) - MinAxe) * LEch * Sin(Alpha0)
xy2(0, 1) = X0 + (tb2(1) - MinAxe) * LEch * Cos(Alpha0)
.AddNodes msoSegmentLine, msoEditingAuto, xy2(0, 0), xy2(0, 1)
For i = 1 To n - 1
xy2(i, 0) = Y0 + (tb2(i + 1) - MinAxe) * LEch * Sin(Alpha0 + i * AlphaN)
xy2(i, 1) = X0 + (tb2(i + 1) - MinAxe) * LEch * Cos(Alpha0 + i * AlphaN)
.AddNodes msoSegmentLine, msoEditingAuto, xy2(i, 0), xy2(i, 1)
Next i
'fermeture de la 2ème limite
.AddNodes msoSegmentLine, msoEditingAuto, xy2(0, 0), xy2(0, 1)
'fin de la contruction
With .ConvertToShape
.Name = "Vie Cycle"
With .Fill
.ForeColor.RGB = RGB(0, 255, 255)
.Transparency = 0.2
.Solid
End With
.Line.Visible = msoFalse
End With
End With
'Comparaison des points des 2 courbes, repérage du point de départ éventuel des formes secondaires
ReDim comp(0 To n - 1)
comp(0) = Abs(tb2(1) = tb1(1)) + 2 * Abs(tb2(1) > tb1(1)) + 4 * Abs(tb2(1) < tb1(1))
diff = False
For i = 0 To n - 1
j = (i + 1) Mod n
comp(j) = Abs(tb2(j + 1) = tb1(j + 1)) + 2 * Abs(tb2(j + 1) > tb1(j + 1)) + 4 * Abs(tb2(j + 1) < tb1(j + 1))
If comp(i) <> comp(j) And comp(j) <> 1 Then
If diff = False Then Start = i
diff = True
End If
Next i
'Cas triviaux
If Not diff Then
With Chrt.Shapes("Vie Cycle")
Select Case comp(1)
Case 1
.Delete 'les deux courbes sont confondues
Case 2
.Fill.ForeColor.RGB = RGB(0, 255, 0) 'Fin de cycle > début de cycle
Case 4
.Fill.ForeColor.RGB = RGB(255, 0, 0) 'Fin de cycle < début de cycle
End Select
End With
Exit Sub
End If
'créer des formes secondaires en fonction de la position des courbes
Chrt.Shapes("Vie Cycle").Delete
Début = Start
continuer = True
While continuer
Début = FormesSecondaires(Chrt, Début, n, xy1, xy2, comp)
If Début = Start Then Exit Sub
Wend
End Sub