Graphique anneau simple 3 secteurs

Bonsoir le forum

j'utilise ce code pour un graphique avec un anneau composé de 3 secteurs.

Les 3 secteurs possèdent une couleur différente Point (1) Point (2) Point(3)

Voici un code que j'ai récupéré puis adapter à mon besoin.

Private Sub CreationGraphique()
    Dim Datas As Range, Accueil As Range
    Dim Graph As Chart
    Dim F As Worksheet
    Dim MaVal As String

    For Each legraphe In ActiveSheet.ChartObjects
        legraphe.Delete
    Next

    Set F = ThisWorkbook.Worksheets("Feuil1")
    Set Datas = F.UsedRange
    Set Accueil = F.Range("F11:L29")
    Set Graph = F.ChartObjects.Add(Accueil.Left, Accueil.Top, Accueil.Width, Accueil.Height).Chart

    With Graph
        .ChartType = xlDoughnut
        .SeriesCollection.NewSeries
        .FullSeriesCollection(1).XValues = F.Range(F.Cells(1, 2), F.Cells(2, Datas.Columns.Count))
        .FullSeriesCollection(1).Values = F.Range(F.Cells(6, 2), F.Cells(6, Datas.Columns.Count))
        .FullSeriesCollection(1).Name = F.Range("A3")
        .FullSeriesCollection(1).ApplyDataLabels
        .ChartTitle.Text = F.Range("A6")
    End With

   Graph.FullSeriesCollection(1).Points(1).Select
        With Selection.Format.Fill
            .Visible = msoTrue
            .ForeColor.RGB = RGB(255, 0, 0)
            .Transparency = 0
            .Solid
        End With

   Graph.FullSeriesCollection(1).Points(2).Select
        With Selection.Format.Fill
            .Visible = msoTrue
            .ForeColor.RGB = RGB(0, 255, 0)
            .Transparency = 0
            .Solid
        End With

    Graph.FullSeriesCollection(1).Points(3).Select
        With Selection.Format.Fill
            .Visible = msoTrue
            .ForeColor.RGB = RGB(0, 0, 190)
            .Transparency = 0
            .Solid
         End With

End Sub

Je pense que l'on peux améliorer ce code avec la méthode Case, mais là je ne l'ai pas encore assimilé.

de plus je n'arrive pas a supprimer la bordure du graph sachant que la commande doit être cela

Line.Visible = msoFalse

Si une personne peux me solutionner mon problème, je la remercie d'avance

à bientôt

Bonjour,

votre code modifié (pas testé)

Private Sub CreationGraphique()
    Dim Datas As Range, Accueil As Range
    Dim Graph As Chart
    Dim F As Worksheet
    Dim MaVal As String

    For Each legraphe In ActiveSheet.ChartObjects
        legraphe.Delete
    Next

    Set F = ThisWorkbook.Worksheets("Feuil1")
    Set Datas = F.UsedRange
    Set Accueil = F.Range("F11:L29")
    Set Graph = F.ChartObjects.Add(Accueil.Left, Accueil.Top, Accueil.Width, Accueil.Height).Chart

    With Graph
        .ChartType = xlDoughnut
        .SeriesCollection.NewSeries
        .FullSeriesCollection(1).XValues = F.Range(F.Cells(1, 2), F.Cells(2, Datas.Columns.Count))
        .FullSeriesCollection(1).Values = F.Range(F.Cells(6, 2), F.Cells(6, Datas.Columns.Count))
        .FullSeriesCollection(1).Name = F.Range("A3")
        .FullSeriesCollection(1).ApplyDataLabels
        .ChartTitle.Text = F.Range("A6")
    End With

   For i = 1 To 3 'du point 1 au point 3
        Graph.FullSeriesCollection(1).Points(i).Select
        With Selection.Format.Fill
            .Visible = msoTrue
            .Transparency = 0
            .Solid
            Select Case i
                Case 1
                    .ForeColor.RGB = RGB(255, 0, 0)
                Case 2
                    .ForeColor.RGB = RGB(0, 255, 0)
                Case 3
                    .ForeColor.RGB = RGB(0, 0, 190)
            End Select
        End With
    Next i
End Sub

Supprimer la bordure du graphique

    Sheets("Feuil1").Shapes("Graphique 1").Line.Visible = msoFalse

Cdlt

Bonjour le forum

Bonjour Arturo83

Merci pour le code modifié et que j'ai testé.

Bravo fonctionne parfaitement

E attendant une réponse, j'ai continué mes recherches sur la méthode Case et m'était rendu compte qu'il fallait aussi que j'utilise une boucle.

Cela dit, j'avais trouvé le code pour supprimer la bordure du graphe.

en faisant comme cela:

With Graph
        .ChartType = xlDoughnut
        .ChartArea.Format.Line.Visible = msoFalse
        .SeriesCollection.NewSeries
        .FullSeriesCollection(1).XValues = F.Range(F.Cells(1, 2), F.Cells(2, Datas.Columns.Count))
        .FullSeriesCollection(1).Values = F.Range(F.Cells(6, 2), F.Cells(6, Datas.Columns.Count))
        .FullSeriesCollection(1).Name = F.Range("A3")
        .FullSeriesCollection(1).ApplyDataLabels
        .ChartTitle.Text = F.Range("A6")
    End With

J'ai mis les couleurs en place, et je m'apercois que celles-ci prennent le dessus sur les ".DatalLabels"

je vais devoir les décaler point par point.

 ActiveChart.FullSeriesCollection(1).Points(1).DataLabel.Select
    Selection.Left = 286.769
    Selection.Top = 198.334

Je vais essayer d'utiliser le même code que tu m'as donné pour l'appliquer.

J’espère que tu vas garder en suivi mon post, si jamais je ne réussi pas, je vais devoir te (vous) demander de l'aide.

A bientôt

Bonne fin de journée au forum

Bonsoir le forum

Bonsoir Arturo83

Voila j'ai trouvé grâce à toi la suite :

For i = 1 To 3 'du point 1 au point 3
        Graph.FullSeriesCollection(1).Points(i).Select

            With Selection.DataLabel.Select

                Select Case i
                     Case 1
                         Selection.Left = 286.769
                         Selection.Top = 201
                         Selection.Format.TextFrame2.TextRange.Font.Size = 16
                     Case 2
                         Selection.Left = 57
                         Selection.Top = 201
                          Selection.Format.TextFrame2.TextRange.Font.Size = 16
                     Case 3
                         Selection.Left = 75
                         Selection.Top = 58
                          Selection.Format.TextFrame2.TextRange.Font.Size = 16
                  End Select
            End With
         Next i
    i = 0

    Range("G1").Activate

pouvez-vous confirmer ce code qui fonctionne et que j'ai ajouté à la suite svp.

Merci
Dernière question, faut-il que je prenne le même raisonnement pour faire un graphique en barre horizontal et qui va reprendre une liste de données plus importante ?

Dans l'attente de vos suggestions

Bonne soirée à tous

Bonjour,

Difficile de répondre si c'est bon ou pas, le mieux c'est d'essayer, si ça ne marche pas, déposez un fichier avec des données bidons mais construit de la même façon que le fichier réel, et là je pourrai vous en dire plus.

Cdlt