génerer des points et mise à jour des couleurs sur un graphe radar

hobine

XLDnaute Nouveau
Bonjour,
J'ai une macro qui me donne les bonnes couleurs sur mon graphe de type radar avec marqueurs.
Ce code fonction parfaitement sur un radar de type <radar avec marqueurs>.
L’objectif serai d'avoir cette macro qui fonctionnera sur un graphe de type radar plein où l'on verra déjà les marqueurs (ce qui n'est pas le cas) et par la suite je pourrai lui attribuer mes couleurs souhaitées

Par contre j'aimerai avoir la même mise à jour avec un graphe de type 'radar plein'. Quand je transforme mon graphe de type radar avec marqueurs en graphe de type radar plein. Je perds toutes boutons (formes carres et circulaires) que j'avais sur le premier graphe. Même en faisant une manipulation manuelle, je ne retrouve pas plus les formes.

J'ai décidé de via un code vba de transformer mon graph1 en graph de type 2. Malgré cela il y a bug en ligne 41


Code:
Sub couleur_points()
'
' couleur_points Macro
'
Dim ColorColone(2) As String

ColorColone(1) = "Couleur_N"
ColorColone(2) = "Couleur_N_1"
strOnglet = "Cartographie"

intCouleur = 46 'par défaut

Worksheets(strOnglet).Activate

For k = 1 To 2
intOffsetLigne = 1
While Worksheets(strOnglet).Range("Carto_Poids_N").Offset(intOffsetLigne + 1, 0).Value <> ""
    If Worksheets(strOnglet).Range(ColorColone(k)).Offset(intOffsetLigne + 1, 0).Value = "r" Then
        intCouleur = 46
    Else
        If Worksheets(strOnglet).Range(ColorColone(k)).Offset(intOffsetLigne + 1, 0).Value = "v" Then
            intCouleur = 39
        Else
            If Worksheets(strOnglet).Range(ColorColone(k)).Offset(intOffsetLigne + 1, 0).Value = "j" Then
                intCouleur = 6
            End If
        End If
    End If

Dim X As Chart
Set X = Charts(1)
'Nom de la feuille où est le graphe
S = X.Name
'MsgBox S
X.Activate
X.ChartType = 82
   ActiveChart.SeriesCollection(k).Select
   
   ActiveChart.SeriesCollection(k).Points(intOffsetLigne).Select

        With Selection
         
                        If k = 1 Then
            .MarkerStyle = xlSquare
            ElseIf k = 2 Then
              .MarkerStyle = xlCircle
            End If
            .MarkerBackgroundColorIndex = intCouleur
            .MarkerForegroundColorIndex = xlAutomatic
            If k = 1 Then
            .MarkerStyle = xlSquare
            ElseIf k = 2 Then
              .MarkerStyle = xlCircle
            End If
            .MarkerSize = 11
            .Shadow = False
        End With
        
    intOffsetLigne = intOffsetLigne + 1
Wend
Next k


Worksheets(strOnglet).Activate

End Sub
 

Discussions similaires

Statistiques des forums

Discussions
312 316
Messages
2 087 185
Membres
103 491
dernier inscrit
bilg1