Excel/VBA: Adding a title to doughnut chart reduces size of doughnut

Viewed 92

...but I want my doughnut to be full sized. As I want to move the title to the center of the doughnut, I don't need the top margin, which is added, it seems, through Chart.HasTitle = True. How can I work around this?

Examplary code

Sub createChart()
    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 = xlDoughnut
        .SetSourceData Source:=dataRng
        ' comment out from here
        .HasTitle = True
        With .ChartTitle
            .Text = "Test"
            .Top = hgt / 2
            .Left = wdth / 2 - 20
        End With
        ' to here
        .HasLegend = False
    End With
End Sub


2 Answers

Add the line .ChartTitle.IncludeInLayout = False after .HasTitle = True.

You can read the documentation on the property for more details on what it does, but basically you set it to

True if a chart title will occupy the chart layout space when a chart layout is being determined

Instead of adding a title, you could add an overlaying element like so:

Sub testCreateChart()
    ActiveSheet.ChartObjects.Delete
    Dim chrt As ChartObject
    Dim dataRng As Range

    Dim lft, wdth, hgt, tp As Integer
        lft = ActiveSheet.Range("D2").Left
        wdth = 500
        hgt = 300
        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 = xlDoughnut
        .SetSourceData Source:=dataRng
        ' comment out from here
        .SetElement msoElementChartTitleCenteredOverlay
        With .ChartTitle
            
            .Text = "Test"
            .Top = hgt / 2 - 20
            .Left = wdth / 2 - 20
        End With
        ' to here
        .HasLegend = False
    End With
End Sub
Related