XL 2019 Graphique radar empilé?

Rabapt

XLDnaute Nouveau
Bonjour à tous.

Existerait il une astuce ou tout simplement une fonctionnalité toute prête pour empiler des radars pleins, je ne parviens pas à les trouver. Je m'explique:

J'ai 4 séries qui fluctuent sur 7 "branches". Une (limite) et une (objectif) qui définira une zone de confort verte. Et une série (début de cycle) et une (fin de cycle) ou elles peuvent se chevaucher > ou < à l'autre.
Si (fin de cycle)>(début de cycle); aire verte ou hachurée; sinon aire rouge.

Merci pour votre aide.

Si vous avez besoin d'autres infos n'hésitez pas.

radar.png
 

AtTheOne

XLDnaute Impliqué
Supporter XLD
Bonsoir @Rabapt
J'ai abouti sur ton problème.
J'ai créé un tableau structuré "t_Données" qui contient les données des 4 séries représentées dans le graphique Radar "Mon_Radar". Elles se nomment respectivement Objectif, Limite, Début de cycle, Fin de Cycle,
La zone entre la ligne Objectif et la ligne Limite est représenté par une forme en vert.
Les zones délimitées par le début et la fin de cycle (de 0 à 6 zones pour un graphique à 7 branches) sont représentées par des formes rouges ou bleues selon les valeurs respectives de début et de fin de cycle.
Cela se fait par une macro et une fonction appelées par un bouton ou par la mise à jour des données.
Voici le code
  • Macro Rdr_Shapes
    Enrichi (BBcode):
    '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
  • Fonction FormesSecondaires
    Enrichi (BBcode):
    Function FormesSecondaires(Chrt As Chart, Start As Byte, n As Byte, xy1, xy2, comp) As Byte
         Dim V1(1 To 3), V2(1 To 3), Delta As Double, continuer As Boolean, back As Byte, k As Integer
    
         i = Start: j = (i + 1) Mod n
         V1(1) = xy1(i, 1) - xy1(j, 1)
         V1(2) = xy1(j, 0) - xy1(i, 0)
         V1(3) = xy1(j, 0) * xy1(i, 1) - xy1(i, 0) * xy1(j, 1)
    
         V2(1) = xy2(i, 1) - xy2(j, 1)
         V2(2) = xy2(j, 0) - xy2(i, 0)
         V2(3) = xy2(j, 0) * xy2(i, 1) - xy2(i, 0) * xy2(j, 1)
         Delta = V1(1) * V2(2) - V2(1) * V1(2)
         If Delta = 0 Then
              FormesSecondaires = j
              Exit Function
         End If
         X0 = (V1(3) * V2(2) - V2(3) * V1(2)) / Delta
         Y0 = (V1(1) * V2(3) - V2(1) * V1(3)) / Delta
         With Chrt.Shapes.BuildFreeform(msoEditingAuto, X0, Y0)
              continuer = True
              back = (i + 1) Mod n
              While continuer
                   i = (i + 1) Mod n: j = (i + 1) Mod n
                   .AddNodes msoSegmentLine, msoEditingAuto, xy1(i, 0), xy1(i, 1)
                   If comp(i) <> comp(j) Then continuer = False
              Wend
              V1(1) = xy1(i, 1) - xy1(j, 1)
              V1(2) = xy1(j, 0) - xy1(i, 0)
              V1(3) = xy1(j, 0) * xy1(i, 1) - xy1(i, 0) * xy1(j, 1)
    
              V2(1) = xy2(i, 1) - xy2(j, 1)
              V2(2) = xy2(j, 0) - xy2(i, 0)
              V2(3) = xy2(j, 0) * xy2(i, 1) - xy2(i, 0) * xy2(j, 1)
              Delta = V1(1) * V2(2) - V2(1) * V1(2)
    
              X1 = (V1(3) * V2(2) - V2(3) * V1(2)) / Delta
              Y1 = (V1(1) * V2(3) - V2(1) * V1(3)) / Delta
              .AddNodes msoSegmentLine, msoEditingAuto, X1, Y1
              continuer = True
              k = (i + 1) Mod n
              While continuer
                   k = (k + n - 1) Mod n
                   .AddNodes msoSegmentLine, msoEditingAuto, xy2(k, 0), xy2(k, 1)
                   If k = back Then continuer = False
              Wend
              .AddNodes msoSegmentLine, msoEditingAuto, X0, Y0
              With .ConvertToShape.Fill
                   .ForeColor.RGB = IIf(comp((Start + 1) Mod n) = 4, RGB(255, 0, 0), RGB(0, 0, 255))
                   .Transparency = 0.25
                   .Solid
              End With
        End With
        FormesSecondaires = IIf(comp(j) = 1, j, i)
    End Function

  • Code de la feuille "Radar"
    Enrichi (BBcode):
    Private Sub Worksheet_Change(ByVal Target As Range)
          If Not Intersect(Target, Me.[t_Données]) Is Nothing Then Rdr_Shapes
     End Sub
Voilà, on pourrait simplifier le code de la macro Rdr_Shapes (2 parties du code sont pratiquement répétées), mais là j'ai été fainéant.

Un exemple de ce que celà donne :
1654015780706.png


Je n'ai pas géré les événements liés au garphique lui même, d'où le bouton pour une MàJ lorsque l'on modifie sa taille, les limites de l'axe ... (il faudrait un module de classe)
Voir le fichier en pièce jointe
Merci de me faire un retour
Amicalement
Alain
 

Pièces jointes

  • Graphique radar empilé .xlsm
    35.3 KB · Affichages: 3

Deadpool_CC

XLDnaute Accro
@AtTheOne ...wow tu recréé tout le radar par code VBA ... quel courage

pourquoi ne pas faire un radar par défaut d'excel, fixer son apparence selon son désire et ensuite allez juste mettre à jour les contours ou remplissages des séries incriminées avec du code du genre
VB:
 ActiveSheet.ChartObjects("Graphique 2").Activate
    ActiveChart.FullSeriesCollection(2).Select
    With Selection.Format.Line
        .Visible = msoTrue
        .ForeColor.RGB = RGB(192, 0, 0)
        .Transparency = 0
    End With
    With Selection.Format.Line
        .Visible = msoTrue
        .ForeColor.RGB = RGB(255, 0, 0)
        .Transparency = 0
    End With
    Selection.Format.Fill.Visible = msoFalse
    With Selection.Format.Line
        .Visible = msoTrue
        .ForeColor.RGB = RGB(255, 0, 0)
        .Transparency = 0
    End With

Cela t'aurais éviter plein de code ...
En tout cas chapeau.
 

AtTheOne

XLDnaute Impliqué
Supporter XLD
Bonsoir @Deadpool_CC

Je ne reconstitue pas complétement le graphique mais je crée des aires entre les courbes (ces aires n'existent pas dans le graphique), sauf erreur de ma part, la méthode que tu proposes ne permet que de modifier les lignes et non pas de remplir des surfaces entre deux courbes ...

Si je me trompe, peux-tu m'envoyer un fichier exemple ?

Merci
Amicalement
Alain
 

Deadpool_CC

XLDnaute Accro
(oupps désolé , j'avais oublié le bonjour sur le post précédent ... honte à moi)

ha ... mais j'avais compris que les aires objectifs et limite devaient simplement ressortir Donc en jouant avec la transparence pour ces 2 zones et l'ordre des données (pour qu'elles s'affichent au dessus) l'effet visuel aurait pu être sympa. et surtout bien moins de code.
Mais encore une fois Alain : chapeau pour la solution :)
 

AtTheOne

XLDnaute Impliqué
Supporter XLD
Re Bonsoir
Une (limite) et une (objectif) qui définira une zone de confort verte
Si (fin de cycle)>(début de cycle); aire verte ou hachurée; sinon aire rouge.
Je comprends qu'il faut remplir les surfaces d'une part entre les courbes "limite" et "Objectif" et d'autre part entre "Fin de cycle" et "Début de cycle" et ça je ne sais pas le faire sans construire des formes.
Mais si quelqu'un a une meilleure proposition, je suis preneur !

J'attends la réponse de @Rabapt

En PJ une version avec une Sub pour créer les deux formes principales au lieu de répéter deux fois une même partie de code.

Amicalement
Alain
 

Pièces jointes

  • Graphique radar empilé - v02.xlsm
    35.3 KB · Affichages: 3

Statistiques des forums

Discussions
311 720
Messages
2 081 910
Membres
101 837
dernier inscrit
Ugo