- Excel Version
- 2013
This article shows how to create a donut chart with multiple levels.
- Figure 1 shows how to arrange the source data in order to get the layers. If necessary, you can have two starting angles. To accomplish that, use a secondary axis. The chart below has one series on the primary axis and the other two on the secondary. It is a combination chart, and the hole size for the primary series is smaller.
- Figures 2 and 3 are extreme examples of this technique, the amphitheatre and the Nakshatra chart. Both use a source table with 11 columns and 276 rows.
- The code used to apply some formatting to the Nakshatra chart is also shown, as well as a link to the test workbook.
- One advantage of this method is that the charts are highly customizable via VBA.
VBA Code:
Sub Main()
Dim c As Chart, d As DataLabel, arr, i%, p As Point, pts As Points, cs As Worksheet, j%, a, s As Series
Set cs = Sheets("sheet2")
Set c = cs.ChartObjects("chart 4").Chart
arr = Sheets("sheet1").[c20:c31]
c.FullSeriesCollection(3).ApplyDataLabels
j = 0
For i = cs.Range("d1").End(xlDown).Row To cs.Range("d" & Rows.Count).End(xlUp).Row
j = j + 1
Set p = c.FullSeriesCollection(3).Points(i)
p.DataLabel.Text = CStr(arr(j, 1))
Next
DoCircAlign c.FullSeriesCollection(3), 0
arr = Sheets("sheet1").[d20:d127]
j = 0
For i = cs.Range("g1").End(xlDown).Row To cs.Range("g" & Rows.Count).End(xlUp).Row
j = j + 1
Set p = c.FullSeriesCollection(6).Points(i)
p.DataLabel.Text = CStr(arr(j, 1))
Next
DoCircAlign c.FullSeriesCollection(6), 0
c.FullSeriesCollection(8).ApplyDataLabels
arr = Sheets("sheet1").[g20:g46]
j = 0
For i = cs.Range("i1").End(xlDown).Row To cs.Range("i" & Rows.Count).End(xlUp).Row
j = j + 1
Set p = c.FullSeriesCollection(8).Points(i)
p.DataLabel.Text = CStr(arr(j, 1))
Next
DoCircAlign c.FullSeriesCollection(8), 0
c.FullSeriesCollection(10).ApplyDataLabels
arr = Sheets("sheet1").[h20:h46]
j = 0
For i = cs.Range("k1").End(xlDown).Row To cs.Range("k" & Rows.Count).End(xlUp).Row
j = j + 1
Set p = c.FullSeriesCollection(10).Points(i)
p.DataLabel.Text = CStr(arr(j, 1))
Next
DoCircAlign c.FullSeriesCollection(10), 0
a = Array(3, 6, 8, 10)
On Error Resume Next
For j = LBound(a) To UBound(a)
Set s = c.SeriesCollection(a(j))
For i = 1 To s.Points.Count
If s.Points(i).DataLabel.Text = "0" Then s.Points(i).DataLabel.Delete
Next
Next
End Sub
Public Sub DoCircAlign(oSeries As Series, radial As Boolean)
' by Krisztina Szabó
Dim oChart As Chart, oPoint As Point, ox As Double, oy As Double, value
Dim sum As Double, angleSoFar As Double, i As Long
Set oChart = oSeries.Parent.Parent 'Series < ChartGroup < Chart
ox = oChart.PlotArea.Left + (oChart.PlotArea.Width / 2)
oy = oChart.PlotArea.Top + (oChart.PlotArea.Height / 2)
If oSeries.Type = xlPie Or oSeries.Type = xlDoughnut Then
sum = 0
For Each value In oSeries.Values
sum = sum + value
Next
i = 1
angleSoFar = oSeries.Parent.FirstSliceAngle 'Starts from 12h?
For Each oPoint In oSeries.Points
value = oSeries.Values(i)
angleSoFar = AlignSliceLabel(oChart, ox, oy, sum, angleSoFar, CDbl(value), _
oPoint, radial)
i = i + 1
Next
Else
For Each oPoint In oSeries.Points
AlignPointLabel oChart, ox, oy, oPoint, radial
Next
End If
'Error may occur: 'Method 'Position' of object 'DataLabels' failed
On Error Resume Next
oSeries.DataLabels.Position = xlLabelPositionOutsideEnd
End Sub
Private Function AlignSliceLabel#(ch As Chart, ox As Double, oy As Double, sum#, _
angleSoFar As Double, value As Double, oPoint As Point, radial As Boolean)
Dim oDataLabel As DataLabel, slice As Double, deg As Double
On Error Resume Next
Set oDataLabel = oPoint.DataLabel
On Error GoTo 0
If IsObject(oDataLabel) Then
slice = 360 * value / sum
deg = angleSoFar + slice / 2
If deg > 270 Then
deg = deg - 360
ElseIf deg > 180 Then
deg = deg - 180
ElseIf deg > 90 Then
deg = deg - 180
End If
If radial Then
oDataLabel.Orientation = IIf(deg <= 0, -90 - deg, 90 - deg)
Else
'Tangential
oDataLabel.Orientation = 0 - deg
End If
End If
AlignSliceLabel = angleSoFar + slice
End Function
Private Sub AlignPointLabel(ch As Chart, ox As Double, oy As Double, _
oPoint As Point, radial As Boolean)
Dim oDataLabel As DataLabel, rx#, ry#, dx#, dy#, tg As Double, rad#, deg#
On Error Resume Next
Set oDataLabel = oPoint.DataLabel
On Error GoTo 0
If IsObject(oDataLabel) Then
rx = (oPoint.Left + oPoint.Width / 2)
ry = (oPoint.Top + oPoint.Height / 2)
dx = rx - ox
dy = ry - oy
If dx <> 0 Then
tg = dy / dx
rad = Atn(tg)
deg = rad * 180 / WorksheetFunction.Pi
Else
deg = 90
End If
If radial Then
oDataLabel.Orientation = 0 - deg
Else
'Tangential
oDataLabel.Orientation = _
IIf(0 - deg - 90 >= -90, 0 - deg - 90, 0 - deg + 90)
End If
End If
End Sub
