CODEWITHSUNDEEP
vbageometrypowerpoint
Azad
Azad

Reputation: 11

Arcs Around a Circle

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

enter image description here

Upvotes: 1

Views: 323

Answers (1)

Loki Patera
Loki Patera

Reputation: 41

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

Upvotes: 1

Related Questions