excelvbaexcel-charts

How to dynamically set a doughnut chart size in vba?


I have been racking my brain to fix this issue. For reasons I cannot figure out, the doughnut charts are displaying really tiny. So, I have a bunch of charts that I am generating on the fly and stacking them next to each other. I am setting the chart dimensions on the fly, but there is so much empty space inside the border of the chart that can be used to make the doughnut bigger. I am enclosing some additional details below:

What I have right now: enter image description here

What I want:

enter image description here

This is the code that I have:

Set ws = ActiveSheet

Const numChartsPerRow = 3
Const TopAnchor As Long = 8
Const LeftAnchor As Long = 380
Const HorizontalSpacing As Long = 3
Const VerticalSpacing As Long = 3
Const ChartHeight As Long = 125
Const ChartWidth As Long = 210
Counter = 0

For Each zChartSet In ws.ChartObjects
    zChartSet.Delete
Next zChartSet

While j <= iTeamMemberCount
ActiveSheet.Shapes.AddChart2(251, xlDoughnut).Select
    ActiveChart.SetSourceData Source:=Worksheets("Analytics Team Stats").Range("E" & j & ":F" & j)
    ActiveChart.FullSeriesCollection(1).Select
    Application.CutCopyMode = False
    ActiveChart.FullSeriesCollection(1).Delete
    ActiveChart.SeriesCollection.NewSeries
    ActiveChart.FullSeriesCollection(1).Name = "=""series1"""
    ActiveChart.FullSeriesCollection(1).Values = "={1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1}" 
    ActiveChart.ChartTitle.Select
    Selection.Caption = Split(Worksheets("Analytics Team Stats").Range("A" & j), ",")(1) & " - " & Format(Worksheets("Analytics Team Stats").Range("E" & j), "0%")
    ActiveChart.FullSeriesCollection(1).Select
    ActiveChart.FullSeriesCollection(1).Explosion = 15
    ActiveChart.ChartGroups(1).DoughnutHoleSize = 55
     
    ActiveChart.FullSeriesCollection(1).Select
    With Selection.Format.Fill
        .Visible = msoTrue
        .ForeColor.ObjectThemeColor = msoThemeColorBackground1
        .ForeColor.TintAndShade = 0
        .ForeColor.Brightness = -0.0500000007
        .Solid
    End With
    
    With Selection.Format.Fill
        .Visible = msoTrue
        .ForeColor.ObjectThemeColor = msoThemeColorAccent1
        .ForeColor.TintAndShade = 0
        .ForeColor.Brightness = -0.5
        .Transparency = 0
        .Solid
    End With
    
    ActiveChart.FullSeriesCollection(1).Select
    Application.CutCopyMode = False
    Application.CutCopyMode = False
    ActiveChart.SeriesCollection.NewSeries
    ActiveChart.FullSeriesCollection(2).Name = Worksheets("Analytics Team Stats").Range("A" & j)
    ActiveChart.FullSeriesCollection(2).Values = Worksheets("Analytics Team Stats").Range("E" & j & ":F" & j)
     
    ActiveChart.FullSeriesCollection(2).Select
    ActiveChart.FullSeriesCollection(2).AxisGroup = 2
     
    ActiveChart.FullSeriesCollection(2).Select
    ActiveChart.FullSeriesCollection(2).Points(1).Select
    Selection.Format.Fill.Visible = msoFalse
     
    ActiveChart.FullSeriesCollection(2).Select
    ActiveChart.FullSeriesCollection(2).Points(2).Select
    With Selection.Format.Fill
        .Visible = msoTrue
        .ForeColor.ObjectThemeColor = msoThemeColorBackground1
        .ForeColor.TintAndShade = 0
        .ForeColor.Brightness = -0.0500000007
        .Transparency = 0
        .Solid
    End With
    With Selection.Format.Fill
        .Visible = msoTrue
        .ForeColor.ObjectThemeColor = msoThemeColorBackground1
        .ForeColor.TintAndShade = 0
        .ForeColor.Brightness = 0
        .Transparency = 0.1999999881
        .Solid
    End With
    ActiveChart.SetElement (msoElementLegendNone)
    
    j=j+1
    wend

Solution

  • To automate the ring thickness process, you should think like this: a) Thickness is a function of the smaller of height and width. b) Find the smallest possible width-height value, then test which value of DonutHoleSize is satisfactory. c) Do the same with the smallest of the largest possible height or width. So we will have two pairs of numbers (x1, y1) and (x2, y2) which are read as follows: For the minimum width/height x1 satisfies me for DonutHoleSize the value y1, and for the maximum width/height x2 satisfies me for the DonutHoleSize the value y2. You can now apply the method of linear interpolation to find a satisfactory value for DonutHoleSize for a width/height >= x1 and <= x2. The formula is as follows:

    Public Function linear_interpolation(x1 As Double, y1 As Double, x2 As Double, y2 As Double, ByVal x As Double) As Double
       If (x2 - x1) = 0 Then   'division by zero
          linear_interpolation = 0#  'or anything else...maybe y1 or y2 ...
       Else
          linear_interpolation = y1 + (((x - x1) * (y2 - y1)) / (x2 - x1))
       End If
    End Function
    
    Function minOf(a As Variant, b As Variant) As Variant
       If (a < b) Then minOf = a Else minOf = b
    End Function
    
    'and the usage in code:
    ActiveChart.ChartGroups(1).DoughnutHoleSize = linear_interpolation(280, 75, 85, 50, minOf(ActiveChart.Chart.ChartArea.Width, ActiveChart.Chart.ChartArea.Height))
    

    In my own tests, pairs 280,75 and 85,50 are satisfactory, you can as I described above, adjust them.