Option Explicit
'**************************************************************
Rem die Kreisgrunddaten über alles
Dim kTop As Long    'Kreispositionen
Dim kLeft As Long
Dim kWidth As Long  'Kreisgröße
Dim kLine As Long   'Linienstärke
Dim klColor As Long 'linienfarbe
Dim kAngle As Long  'Winkel
Dim kfColor As Long 'Füllfarbe
'**************************************************************
Sub Kreissegmente()
Dim x 'Zähler
Dim Rng As Range

'**************************************************************
Rem dieser Teil dient nur zur Demo
'lösche Tabelle insgesamt
ActiveSheet.Cells.Clear
ActiveSheet.Cells.ClearContents
For x = ActiveSheet.Shapes.Count To 1 Step -1
  ActiveSheet.Shapes(x).Delete
Next x
'Testdaten in Spalte A
For x = 1 To 4
  With Cells(x, 1)
    .NumberFormat = "0"
    .Value = WorksheetFunction.RandBetween(10, 60)
  End With
  With Cells(x, 2)
    .NumberFormat = "0%"
    .Value = Round(Cells(x, 1).Value / 100, 2)
  End With
Next x
Set Rng = [A1].CurrentRegion
With ActiveSheet
  .Sort.SortFields.Clear
  .Sort.SortFields.Add Key:=Range([A1], [A1].End(xlDown)), _
      SortOn:=xlSortOnValues, _
      Order:=xlAscending, _
      DataOption:=xlSortNormal
End With
With ActiveSheet.Sort
  .SetRange Range(Rng.Address)
  .Header = xlGuess
  .MatchCase = False
  .Orientation = xlTopToBottom
  .SortMethod = xlPinYin
  .Apply
End With
'**************************************************************


'**************************************************************
Rem jetzt die Kreis - Zwiebeltechnik
'erster Kreis mit den Grundpositionen
kTop = 180
kLeft = 80
kWidth = 100
kLine = 10
klColor = 13
kfColor = 1
'Vollkreis 360 Grad = 100 % entspricht -90 oder 270
kAngle = -90
  KreisMit kAngle, kfColor, klColor 'erzeugen
 
'**************************************************************
Rem ein Demo  Algorithmus zur Segmenterzeugung
'die Kreise darüberlegen
For Each Rng In Range([B1], [B1].End(xlDown))
  kAngle = Round((-90 + 360) * Rng.Value, 0)
  kfColor = kfColor + 1
  KreisMit kAngle, kfColor, klColor 'erzeugen
Next Rng

'**************************************************************
[A1].End(xlDown).Select
End Sub

Private Sub KreisMit(ra, fc, lc)
    ActiveSheet.Shapes.AddShape(msoShapePie, kTop, kLeft, kWidth, kWidth).Select
    Selection.ShapeRange.ScaleHeight 1, msoFalse, msoScaleFromTopLeft
    Selection.ShapeRange.ScaleWidth 1, msoFalse, msoScaleFromTopLeft
    
    Selection.ShapeRange.Fill.ForeColor.ObjectThemeColor = fc
    Selection.ShapeRange.Line.ForeColor.ObjectThemeColor = lc
    Selection.ShapeRange.Line.Weight = kLine
    Selection.Placement = xlFreeFloating
    
    Selection.ShapeRange.Adjustments.Item(1) = ra
'**************************************************************
Rem rumspielen kannste auch mit
'.ShapeRange.Fill.Transparency = 1
'.ShapeRange.Line.DashStyle = msoLineDash
'.ShapeRange(1).TextFrame2.TextRange.Characters.Text = "MeinText"
'.ShapeRange(1).TextFrame2.TextRange.Characters.Font.Size = 8
'usw
End Sub