Hallo,
für die Darstellung von Prozentwerten im Rahmen eines Projektreportings werden kleine Tortendiagramme mit Hilfe von Arc-Shapes dargestellt. Das habe ich bisher mit Copy und Paste der Vorgezeichneten Shapes getan. Jetzt möchte ich die Shapes mit VBA erzeugen. Das klappt auch, nur tanzt das modifizierte Arc-Shape immer hin und her, so dass eine exakte Darstellung nicht möglich ist. Hat sich schon mal jemand damit befasst?
Hier mein Code:
Radius = 10
ActiveSheet.Shapes.AddShape(msoShapeArc, 360, 13, Radius, Radius).Select
With Selection
With .ShapeRange
.Flip msoFlipHorizontal
.IncrementRotation 90#
.Height = Radius
.Width = Radius
.Adjustments.Item(1) = 360
.Fill.ForeColor.SchemeColor = 9
.Fill.Solid
.Line.Weight = 0.75
.Line.ForeColor.RGB = RGB(128, 128, 128)
.ZOrder msoBringToFront
End With
.Name = "Kreis"
End With
For a = 1 To 100
ActiveSheet.Shapes.AddShape(msoShapeArc, 360, 13, Radius, Radius).Select
With Selection
With .ShapeRange
.Flip msoFlipHorizontal
.IncrementRotation 90#
.Height = Radius
.Width = Radius
.Adjustments.Item(1) = Int((360 / 100) * a)
.Fill.ForeColor.SchemeColor = 8
.Fill.Solid
.Line.Weight = 0.75
.Line.ForeColor.RGB = RGB(128, 128, 128)
End With
End With
DoEvents
For b = 1 To 2000000
Next
Selection.Delete
Next
ActiveSheet.Shapes("Kreis").Delete