Doughnut chart plot area shrinks on its whim dynamically

jammerules

New Member
Joined
Nov 16, 2009
Messages
13
Office Version
  1. 365
Platform
  1. Windows
Hello, I know I am making a mistake somewhere but I don't know where. Let me explain my problem.

So, I have a table with data for the charts like below:

1681311870039.png


The vba code will dynamically generate charts like below:
1681311887716.png


However, as I change the "% Done" values in column B in the table, and generate the charts, for some reason, the plot area is getting shrunk and the doughnut size increasing randomly.
1681311903521.png

VBA Code:
Sub TeamStatsReport()
    
    
    Dim iStart As Integer, iSprintCount As Integer, iProgramIncrement As Integer, iSprint As Integer
    Dim bLoop As Boolean, bSprintFound As Boolean, bActiveSprint As Boolean, bFutureSprint As Boolean
    Dim sCurrentSprint As String, sNextSprint As String, sCurrentSprintID As String, sNextSprintID As String, sActiveSprint As String
    Dim Counter As Long, ws As Worksheet, zChartSet As ChartObject, colPos As Long, rowNumber As Long
    
    j = 4
    Set SprintsDict = CreateObject("Scripting.Dictionary")
    Set ws = ActiveSheet
    
    Const numChartsPerRow = 4
    Const TopAnchor As Long = 8
    Const LeftAnchor As Long = 450
    Const HorizontalSpacing As Long = 3
    Const VerticalSpacing As Long = 3
    Const ChartHeight As Long = 115
    Const ChartWidth As Long = 170
    Counter = 0
    
  
    
    For Each zChartSet In ws.ChartObjects
        zChartSet.Delete
    Next zChartSet

    While j < 12
        ActiveSheet.Shapes.AddChart2(251, xlDoughnut).Select
        ActiveChart.SetSourceData Source:=Worksheets("Infra Team Stats_").Range("B" & j & ":C" & j)
        ActiveChart.FullSeriesCollection(1).Select
        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 = Worksheets("Infra Team Stats_").Range("A" & j) & " - " & Format(Worksheets("Infra Team Stats_").Range("B" & j), "0%")


        ActiveChart.FullSeriesCollection(1).Select
'        ActiveChart.FullSeriesCollection(1).Explosion = 15
        ActiveChart.ChartGroups(1).DoughnutHoleSize = 40

        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("Infra Team Stats_").Range("A" & j)
        ActiveChart.FullSeriesCollection(2).Values = Worksheets("Infra Team Stats_").Range("B" & j & ":C" & 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)
        
        ActiveChart.PlotArea.Select
        Selection.Width = 220
        Selection.Height = 120
        With ActiveChart
         .PlotArea.Left = (.ChartArea.Width - .PlotArea.Width) / 2
         .PlotArea.Top = (.ChartArea.Height - .PlotArea.Height) / 2
        End With
  
        j = j + 1
    Wend
    
    For Each zChartSet In ws.ChartObjects
        rowNumber = Int(Counter / numChartsPerRow)
        colPos = Counter Mod numChartsPerRow

        With zChartSet
            .Top = TopAnchor + rowNumber * (VerticalSpacing + ChartHeight)
            .Left = LeftAnchor + colPos * (HorizontalSpacing + ChartWidth)
            .Height = ChartHeight
            .Width = ChartWidth
        End With

        Counter = Counter + 1
    Next zChartSet

End Sub

Here is the code I have:
 

Excel Facts

Add Bullets to Range
Select range. Press Ctrl+1. On Number tab, choose Custom. Type Alt+7 then space then @ sign (using 7 on numeric keypad)

Forum statistics

Threads
1,214,932
Messages
6,122,323
Members
449,077
Latest member
jmsotelo

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top