AW: Kuchendiagramm
10.08.2011 13:58:08
otto
Hi,
Ansatz:
Option Explicit
Const Faktor = 0.5 'wählen
Sub Test()
Dim Diagramm As Series, anzPkte As Long, Punkt As Long
Dim PosMitte() As Variant, PosAussen() As Variant
Set Diagramm = ActiveChart.SeriesCollection(1)
anzPkte = Diagramm.Points.Count
'Koordinaten Left und Top, wenn Label in der Mitte
ReDim PosMitte(2, anzPkte)
Diagramm.DataLabels.Position = xlLabelPositionCenter
For Punkt = 1 To anzPkte
PosMitte(1, Punkt) = Diagramm.Points(Punkt).DataLabel.Left
PosMitte(2, Punkt) = Diagramm.Points(Punkt).DataLabel.Top
Next Punkt
'Koordinaten Left und Top, wenn Label aussen
ReDim PosAussen(2, anzPkte)
Diagramm.DataLabels.Position = xlLabelPositionOutsideEnd
For Punkt = 1 To anzPkte
PosAussen(1, Punkt) = Diagramm.Points(Punkt).DataLabel.Left
PosAussen(2, Punkt) = Diagramm.Points(Punkt).DataLabel.Top
Next Punkt
'Koordinaten um Differenz Aussen zu Mitte und multipliziert mit Faktor verschoben
For Punkt = 1 To anzPkte
Diagramm.Points(Punkt).DataLabel.Left = _
Diagramm.Points(Punkt).DataLabel.Left + (PosAussen(1, Punkt) - PosMitte(1, Punkt)) * _
Faktor
Diagramm.Points(Punkt).DataLabel.Top = _
Diagramm.Points(Punkt).DataLabel.Top + (PosAussen(2, Punkt) - PosMitte(2, Punkt)) * _
Faktor
Next Punkt
Set Diagramm = Nothing
End Sub
Gruß