Chart type related problems when setting up chart type xlDoughnut

Question

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

This doesn't really make anything easier, but could you add text to the overlaying circle, where that text references the chart title that could be populated in another cell? Like a formula (=Sheet1!$E$1) for example. — Isolated, Sep 28 '20 at 21:09
I don't know VBA, but in excel you could just double-click on the circle until the blinking cursor appears, then in your formula bar type "=e1". Cell E1 would be where you place the title. You can then middle and center align the text. — Isolated, Sep 29 '20 at 13:59

score 1 · Accepted Answer · answered Sep 29 '20 at 02:40

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

Chart type related problems when setting up chart type xlDoughnut

1 Answers1