XL 2010 Graphique "anneau" : placement des étiquettes

Vinny

XLDnaute Nouveau
Bonjour à tous.
Je souhaite créer un graphe de type anneau.
Les étiquettes doivent se trouver à l'extérieur de l'anneau.
Pas vraiment de difficulté à ce stade, il me suffit de sélectionner manuellement chaque étiquette et de les déplacer.
Là où j'ai un souci c'est lorsque je change la source des données (ou directement les valeurs des données).
Dans ce cas l'emplacement des étiquettes change de manière, hum... désordonnée disons.
Dans les options de Format des étiquettes de données, je ne vois pas la possibilité de placer les étiquettes hors des formes, de manière automatique...
Merci par avance de votre aide.
 

PMO2

XLDnaute Accro
Bonjour,
Ce message est ancien et je sais pas si il est encore temps d'apporter une réponse mais pour le fun j'indique une piste ci-dessous.

1) Copiez le code suivant dans un module standard
VB:
Sub aa()
Const DECAL As Double = 40  '### Décalage en points à adapter ###
Dim CH As Chart
Dim PT As Point
Dim DL As DataLabel
Dim X0 As Double
Dim Y0 As Double
Dim X As Double
Dim Y As Double
Dim a As Double
Dim b As Double
Dim c As Double
Dim Coeff As Double
'---
If TypeName(Selection) <> "ChartArea" Then Exit Sub
Set CH = Selection.Parent
If CH.ChartType <> xlDoughnut Then Exit Sub

On Error Resume Next
CH.SetElement (msoElementDataLabelNone)
Application.CommandBars.ExecuteMso ("ChartEditDataSource")
CH.SetElement (msoElementDataLabelShow)
If Err <> 0 Then Exit Sub
On Error GoTo 0
'--- Coordonnées du centre du graphique Anneau ---
With ActiveChart.PlotArea
    X0 = ((.Width) / 2) + .Left
    Y0 = ((.Height) / 2) + .Top
End With
'--- Boucle sur les étiquettes de données (DataLabel) ---
For Each PT In CH.SeriesCollection(1).Points
  Set DL = PT.DataLabel
  Call DataLabelRefresh 'rafraîchissement indispensable
  '--- Coordonnées du DataLabel ---
  X = DL.Left
  Y = DL.Top
  '/// Algorithme pour déterminer ses nouvelles coordonnées (4 cas) ///
  If Y <= Y0 And X <= X0 Then
    a = X0 - X
    b = Y0 - Y
    c = Sqr(a ^ 2 + b ^ 2)
    Coeff = (c + DECAL) / c
    DL.Left = X0 - (a * Coeff)
    DL.Top = Y0 - (b * Coeff)
  ElseIf Y <= Y0 And X >= X0 Then
    a = X - X0
    b = Y0 - Y
    c = Sqr(a ^ 2 + b ^ 2)
    Coeff = (c + DECAL) / c
    DL.Left = X0 + (a * Coeff)
    DL.Top = Y0 - (b * Coeff)
  ElseIf Y >= Y0 And X <= X0 Then
    a = X0 - X
    b = Y - Y0
    c = Sqr(a ^ 2 + b ^ 2)
    Coeff = (c + DECAL) / c
    DL.Left = X0 - (a * Coeff)
    DL.Top = Y0 + (b * Coeff)
  ElseIf Y >= Y0 And X >= X0 Then
    a = X - X0
    b = Y - Y0
    c = Sqr(a ^ 2 + b ^ 2)
    Coeff = (c + DECAL) / c
    DL.Left = X0 + (a * Coeff)
    DL.Top = Y0 + (b * Coeff)
  End If
  '////////////////////////////////////////////////////////////////////
  Call DataLabelRefresh 'rafraîchissement indispensable
  '--- Divers réglages du DataLabel ---
    '°°° Taille de la police °°°
  DL.Characters.Font.Size = 14
    '°°° Couleur du fond °°°
  DL.Interior.Color = PT.Format.Fill.ForeColor.RGB
  'etc
Next PT
End Sub

Sub DataLabelRefresh(Optional dummy As Byte)
Dim i&
'---
For i& = 1 To 10
  DoEvents
Next i&
End Sub

2) Sélectionnez le graphique anneau et lancez la macro
 

Pièces jointes

  • Graphique anneau - placement externe des étiquettes (DataLabel).xlsm
    24.7 KB · Affichages: 44

CB60

XLDnaute Barbatruc
Bonjour
le plus simple je pense, qu'il suffit de ne pas afficher les étiquettes de cet anneau, d'ajouter un nouvelle série (avec les mêmes valeurs), de lui assigner en couleur aucune, et d'afficher les étiquettes, de cette façon les étiquettes suivront obligatoirement les données
Capture.GIF
 

Discussions similaires

Statistiques des forums

Discussions
312 201
Messages
2 086 166
Membres
103 149
dernier inscrit
Deepkneec