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