XL 2013 Graphique double anneau et code VBA pour labels

[ruhlito]

Bonjour a tous,

Je travaille actuellement sur un graphique en camembert (double anneau) et galere un peu avec mon code VBA... J'espere pouvoir beneficier de conseils sur mon probleme (je suis sur que le code peut aussi etre raccourci mais rien ne presse de ce cote la)

L'anneau interieur de mon graphique represente le nombre d'echecs par categorie alors que l'exterieur represente le montant perdu par categorie. Je pensais qu'il serait assez simple de mettre les labels par valeur (anneau 1) et en % (anneau 2). Cependant, seul mon code pour le pourcentage est pris en compte...

Voici mon code, si qlqn a une idee:

Sub GraphFund6()

'Failure per Investment size

ActiveSheet.ChartObjects(6).Activate
ActiveChart.ApplyDataLabels Type:=xlDataLabelsShowLabel
With ActiveChart.SeriesCollection(1)
For i = 1 To .Points.Count
.Points(i).Interior.Color = Range("E676:E681")(i).Interior.Color
.Points(i).Interior.ColorIndex = Range("E676:E681")(i).Interior.ColorIndex
Next i
End With

ActiveChart.FullSeriesCollection(1).Select
ActiveChart.ChartGroups(1).DoughnutHoleSize = 60
ActiveChart.SetElement (msoElementDataLabelShow)

'datalabel1
ActiveChart.FullSeriesCollection(1).DataLabels.Select
Selection.Format.TextFrame2.TextRange.Font.Bold = msoTrue
With Selection.Format.TextFrame2.TextRange.Font.Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(0, 0, 0)
.Transparency = 0
.Solid
End With
Selection.Format.TextFrame2.TextRange.Font.Size = 11
Selection.ShowPercentage = False
Selection.ShowCategoryName = False
Selection.ShowValue = True


ActiveSheet.ChartObjects(6).Activate
ActiveChart.ApplyDataLabels Type:=xlDataLabelsShowLabel
With ActiveChart.SeriesCollection(2)
For i = 1 To .Points.Count
.Points(i).Interior.Color = Range("E676:E681")(i).Interior.Color
.Points(i).Interior.ColorIndex = Range("E676:E681")(i).Interior.ColorIndex
Next i
End With

ActiveChart.FullSeriesCollection(2).Select
ActiveChart.ChartGroups(1).DoughnutHoleSize = 60
ActiveChart.SetElement (msoElementDataLabelShow)
ActiveChart.FullSeriesCollection(2).Explosion = 1

'datalabel
ActiveChart.FullSeriesCollection(2).DataLabels.Select
Selection.Format.TextFrame2.TextRange.Font.Bold = msoTrue
With Selection.Format.TextFrame2.TextRange.Font.Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(0, 0, 0)
.Transparency = 0
.Solid
End With
Selection.Format.TextFrame2.TextRange.Font.Size = 11
Selection.ShowPercentage = True
Selection.ShowCategoryName = False



'titel
ActiveChart.ChartTitle.Select
With Selection.Format.TextFrame2.TextRange.Font.Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(0, 0, 0)
.Transparency = 0
.Solid
Selection.Format.TextFrame2.TextRange.Font.Size = 14
End With

'legend
ActiveChart.Legend.Select
With Selection.Format.TextFrame2.TextRange.Font.Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(0, 0, 0)
.Transparency = 0
.Solid
End With
Selection.Format.TextFrame2.TextRange.Font.Bold = msoFalse
Selection.Format.TextFrame2.TextRange.Font.Size = 11

'size ring
ActiveChart.PlotArea.Select
Selection.Top = 47
Selection.Width = 250
Selection.Height = 250

End Sub


Je ne sais pas si je suis assez clair. Je reste Dispo et tjr ouvert a toute discussion.
Bonne journee et merci d'avance pour vos reponses!

 

[Efgé]

Re : Graphique double anneau et code VBA pour labels

Bonjour ruhlito
Une proposition, non testée par manqe de fichier exemple:
Inverse tes deux lignes:
Selection.ShowCategoryName = False
Selection.ShowValue = True
Mets
Selection.ShowValue = True
Selection.ShowCategoryName = False
Cordialement

 

[ruhlito]

Re : Graphique double anneau et code VBA pour labels

Bonjour Efge,

Je n'ai pas joint le fichier car il fait quasiment 20k KB...
Merci pour ta proposition. J'ai essaye, ca donne un message d'erreur #438