I have written a macro to populate a doughnut chart dynamically. I need the data labels outside of the doughnut. The only way I was able to achieve this was by assigning the data to a chart of type xlPie and running another macro. Setting .ChartGroups(1).DoughnutHoleSize afterwards seems to be a workaround to change the charts appearance to a doughnut, while keeping the data labels in place. If I'd set the chart type to xlDoughnut the data labels would change positions again.
My problem is that when I copy and paste the generated chart to another sheet, the copy is reverted to an xlPie chart, i.e. there is no doughnut hole. Thus, I have tried to add a circle shape over the pie to make it into a doughnut. The problem in this case is that the title of the chart is hidden underneath the circle shape.
Other users of the file have to regularly copy and paste the chart from where it's generated to another file and I would like the pasted chart to look like a doughnut with the title visible. How can I achieve what I am looking for? Below are two subs, showcasing each of the cases. My ideas are:
In createChart_fakeDoughnut1() keep the format when manually copy+pasting the chart, or
in createChart_fakeDoughnut2() set the title to be above the added circle shape.
I don't know how to achieve either of those two. An explanation why fakeDoughnut1 changes its formatting when pasted would also be appreciated.
Sub createChart_fakeDoughnut1()
If ActiveSheet.ChartObjects.Count > 0 Then ActiveSheet.ChartObjects.Delete
Dim chrt As ChartObject
Dim dataRng As Range
Dim lft As Integer
lft = ActiveSheet.Range("D2").Left
Dim wdth As Integer
wdth = 500
Dim hgt As Integer
hgt = 300
Dim tp As Integer
tp = ActiveSheet.Range("D2").Top
Set chrt = ActiveSheet.ChartObjects.Add(Left:=lft, Width:=wdth, Height:=hgt, Top:=tp)
Dim i As Integer
For i = 1 To 10
ActiveSheet.Cells(i, 1).Value = "A" & i
With ActiveSheet.Cells(i, 2)
.Value = i / 55
.NumberFormat = "0.00%"
End With
Next i
Set dataRng = Range("A1:B10")
With chrt.Chart
.ChartType = xlPie
.SetSourceData Source:=dataRng
.HasTitle = True
.ChartTitle.IncludeInLayout = False
With .ChartTitle
.Text = "Test"
.Top = hgt / 2 - 20
.Left = wdth / 2 - 20
End With
.HasLegend = False
' set hole size here
.ChartGroups(1).DoughnutHoleSize = 50
End With
End Sub
Sub createChart_fakeDoughnut2()
If ActiveSheet.ChartObjects.Count > 0 Then ActiveSheet.ChartObjects.Delete
Dim chrt As ChartObject
Dim dataRng As Range
Dim lft As Integer
lft = ActiveSheet.Range("D2").Left
Dim wdth As Integer
wdth = 500
Dim hgt As Integer
hgt = 300
Dim tp As Integer
tp = ActiveSheet.Range("D2").Top
Set chrt = ActiveSheet.ChartObjects.Add(Left:=lft, Width:=wdth, Height:=hgt, Top:=tp)
Dim i As Integer
For i = 1 To 10
ActiveSheet.Cells(i, 1).Value = "A" & i
With ActiveSheet.Cells(i, 2)
.Value = i / 55
.NumberFormat = "0.00%"
End With
Next i
Set dataRng = Range("A1:B10")
With chrt.Chart
.ChartType = xlPie
.SetSourceData Source:=dataRng
.HasTitle = True
With .ChartTitle
.Text = "Test"
.Top = hgt / 2 - 20
.Left = wdth / 2 - 20
End With
.HasLegend = False
' add circle form here
Dim x As Double, y As Double, h As Double, cd As Double
With .PlotArea
x = .Left
y = .Top
h = .Height
End With
cd = 120
Dim circ As Shape
Set circ = .Shapes.AddShape(msoShapeOval, x + h / 2 - cd / 2, _
y + h / 2 - cd / 2, cd, cd)
With circ
.Line.Visible = msoFalse
.Fill.ForeColor.RGB = RGB(255, 255, 255)
End With
End With
End Sub
It would be better to insert one more square shape.
Sub createChart_fakeDoughnut2()
If ActiveSheet.ChartObjects.Count > 0 Then ActiveSheet.ChartObjects.Delete
Dim chrt As ChartObject
Dim dataRng As Range
Dim lft As Integer
lft = ActiveSheet.Range("D2").Left
Dim wdth As Integer
wdth = 500
Dim hgt As Integer
hgt = 300
Dim tp As Integer
tp = ActiveSheet.Range("D2").Top
Set chrt = ActiveSheet.ChartObjects.Add(Left:=lft, Width:=wdth, Height:=hgt, Top:=tp)
Dim i As Integer
For i = 1 To 10
ActiveSheet.Cells(i, 1).Value = "A" & i
With ActiveSheet.Cells(i, 2)
.Value = i / 55
.NumberFormat = "0.00%"
End With
Next i
Set dataRng = Range("A1:B10")
With chrt.Chart
.ChartType = xlPie
.SetSourceData Source:=dataRng
' .HasTitle = True
' With .ChartTitle
' .Text = "Test"
' .Top = hgt / 2 - 20
' .Left = wdth / 2 - 20
' End With
.HasLegend = False
' add circle form here
Dim x As Double, y As Double, h As Double, cd As Double, w As Double
With .PlotArea
x = .Left
y = .Top
h = .Height
w = .Width
End With
cd = 120
Dim circ As Shape
Set circ = .Shapes.AddShape(msoShapeOval, x + h / 2 - cd / 2, _
y + h / 2 - cd / 2, cd, cd)
With circ
.Line.Visible = msoFalse
.Fill.ForeColor.RGB = RGB(255, 255, 255)
End With
Dim Rect As Shape
Set Rect = .Shapes.AddShape(msoShapeRectangle, x + w / 2 - 20, y + h / 2 - 10, 40, 20)
With Rect
.Line.Visible = msoFalse
.Fill.ForeColor.RGB = RGB(255, 255, 255)
.TextFrame2.TextRange = "Test"
With .TextFrame2.TextRange.Font
.Bold = msoCTrue
.Size = 18
With .Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(0, 0, 0)
End With
End With
.TextFrame.AutoSize = True
End With
End With
End Sub