Arcs Around a Circle - vba

Question

I am trying to position an arc around a circle to show in which range our customers perform.
The sub builds an arc which has the same size as the one from the inner circle but I can't position it correctly.
I attached a picture below to demonstrate my problem.
firstang = shp.Chart.ChartGroups(1).FirstSliceAngle
radius = shp.Chart.PlotArea.Height / 2
Pi = 3.14159265358979
z = 1
j = 1
Debug.Print "Charttype: " & shp.Chart.ChartType
gradfaktor = (360 / Pi)
Breite = shp.Chart.PlotArea.Width + 2 * Abstand + 2 * Balkendicke
breitekreissegment = Balkendicke / Breite * 2
For z = 1 To shp.Chart.SeriesCollection(1).Points.Count
Set newshp = sld.Shapes.AddShape(msoShapeBlockArc, 10, 10, Breite, Breite)
x1 = shp.Chart.SeriesCollection(1).Points(z).PieSliceLocation(xlHorizontalCoordinate, xlOuterClockwisePoint)
y1 = shp.Chart.SeriesCollection(1).Points(z).PieSliceLocation(xlVerticalCoordinate, xlOuterClockwisePoint)
x2 = shp.Chart.SeriesCollection(1).Points(z).PieSliceLocation(xlHorizontalCoordinate, xlOuterCounterClockwisePoint)
y2 = shp.Chart.SeriesCollection(1).Points(z).PieSliceLocation(xlVerticalCoordinate, xlOuterCounterClockwisePoint)
newshp.Fill.ForeColor.RGB = farbe
newshp.Line.Transparency = 1
newshp.name = "B1_" & 1
DoEvents
'newshp.Height = shp.Height
DoEvents
newshp.Left = shp.Left + shp.Chart.PlotArea.Left * 0.5 - Balkendicke
newshp.Top = shp.Top + shp.Chart.PlotArea.Top * 0.5 - Balkendicke
newshp.Adjustments.Item(3) = breitekreissegment
l1 = ((x2 - x1) ^ 2 + (y2 - y1) ^ 2) ^ 0.5
alpha1 = (2 * ArcSin((l1 / (2 * radius)))) * 180 / Pi
newshp.Adjustments.Item(1) = alpha1
newshp.Adjustments.Item(2) = firstang
DoEvents
firstang = firstang + alpha1 + WinkelAbstand
Next z
chartcount = chartcount + 1
l1 = ((x2 - x1) ^ 2 + (y2 - y1) ^ 2) ^ 0.5
alpha1 = (2 * ArcSin((l1 / (2 * radius)))) * 180 / Pi

Answer 1

You can do something like this, just make to separate graphs.
Sub test()
Set myCht_01 = ActiveSheet.Shapes.AddChart
Set myCht_02 = ActiveSheet.Shapes.AddChart
With myCht_01
.Chart.ChartType = xlDoughnut
.Chart.SetSourceData Source:=Range("$F$3:$F$4")
.Chart.ChartGroups(1).DoughnutHoleSize = 85
.Chart.Legend.Delete
.Chart.ChartGroups(1).FirstSliceAngle = 180
Set serCol_01 = .Chart.SeriesCollection(1)
With serCol_01
.ApplyDataLabels
For Each lbl In .DataLabels
If lbl.Name = "Text S1P1" Then lbl.Text = "Nein"
If lbl.Name = "Text S1P2" Then lbl.Text = "Ja"
Next lbl
.DataLabels.ShowCategoryName = True
End With
End With
With myCht_02
.Chart.ChartType = xlDoughnut
.Chart.SetSourceData Source:=Range("$E$3:$E$4")
.Line.Visible = msoFalse
.Chart.Legend.Delete
.Chart.SeriesCollection(1).ApplyDataLabels
.Chart.ChartGroups(1).FirstSliceAngle = 270
End With
myCht_02.ScaleWidth 0.75, msoFalse, msoScaleFromMiddle
myCht_02.ScaleHeight 0.75, msoFalse, msoScaleFromMiddle
myCht_02.Fill.Visible = msoFalse
Set shpGroup = ActiveSheet.Shapes.Range(Array(myCht_01.Name, myCht_02.Name)).Group
Exit Sub
shpGroup.Delete
End Sub
Link to example graph