动态生成Doughnut chart时绘图区随机缩小问题求助

问题现象 #

使用VBA动态生成环形图时，首次生成正常；但修改表格中“% Done”列的值并重新生成图表时，绘图区（Plot Area）会随机缩小，导致环形尺寸异常变大。

问题根源分析 #

1. Select/Selection操作的不稳定性：代码中大量依赖Select和Selection操作，这类操作容易受Excel窗口状态、当前选中对象等因素影响，导致后续的尺寸设置指令无法准确执行。
2. PlotArea尺寸设置时机错误：代码先将PlotArea的宽设为220、高设为120，但后续又将ChartObject的宽设为170、高设为115，PlotArea尺寸超出了ChartObject的范围，Excel会自动强制调整PlotArea大小，引发随机缩小的问题。
3. 冗余的Series操作流程：先通过SetSourceData加载数据再删除原Series，再新建Series的操作冗余，多次触发Excel的自动布局逻辑，增加了尺寸异常的概率。

修复后的代码 #

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
    Dim j As Long, newChart As Chart
    
    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
        ' 创建ChartObject并获取Chart对象，避免使用Select
        Set zChartSet = ws.Shapes.AddChart2(251, xlDoughnut).ChartObject
        Set newChart = zChartSet.Chart
        
        ' 直接创建需要的Series，跳过冗余操作
        With newChart.SeriesCollection.NewSeries
            .Name = "series1"
            .Values = Array(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)
        End With
        
        ' 设置图表标题
        newChart.HasTitle = True
        newChart.ChartTitle.Text = ws.Range("A" & j).Value & " - " & Format(ws.Range("B" & j).Value, "0%")
        
        ' 设置环形图参数
        newChart.ChartGroups(1).DoughnutHoleSize = 40
        
        ' 设置第一个Series的填充样式
        With newChart.FullSeriesCollection(1).Format.Fill
            .Visible = msoTrue
            .ForeColor.ObjectThemeColor = msoThemeColorAccent1
            .ForeColor.TintAndShade = 0
            .ForeColor.Brightness = -0.5
            .Transparency = 0
            .Solid
        End With
        
        ' 创建第二个Series
        With newChart.SeriesCollection.NewSeries
            .Name = ws.Range("A" & j).Value
            .Values = ws.Range("B" & j & ":C" & j).Value
            .AxisGroup = 2
            ' 设置第一个点透明
            .Points(1).Format.Fill.Visible = msoFalse
            ' 设置第二个点填充样式
            With .Points(2).Format.Fill
                .Visible = msoTrue
                .ForeColor.ObjectThemeColor = msoThemeColorBackground1
                .ForeColor.TintAndShade = 0
                .ForeColor.Brightness = 0
                .Transparency = 0.1999999881
                .Solid
            End With
        End With
        
        ' 隐藏图例
        newChart.HasLegend = False
        
        j = j + 1
    Wend

    ' 调整图表位置和大小，然后设置PlotArea尺寸
    For Each zChartSet In ws.ChartObjects
        rowNumber = Int(Counter / numChartsPerRow)
        colPos = Counter Mod numChartsPerRow

        ' 先设置ChartObject的大小
        With zChartSet
            .Top = TopAnchor + rowNumber * (VerticalSpacing + ChartHeight)
            .Left = LeftAnchor + colPos * (HorizontalSpacing + ChartWidth)
            .Height = ChartHeight
            .Width = ChartWidth
        End With

        ' 根据ChartArea的尺寸设置PlotArea，居中显示且不超出范围
        With zChartSet.Chart
            .PlotArea.Width = .ChartArea.Width * 0.8 ' 使用比例避免固定值超出范围
            .PlotArea.Height = .ChartArea.Height * 0.7
            .PlotArea.Left = (.ChartArea.Width - .PlotArea.Width) / 2
            .PlotArea.Top = (.ChartArea.Height - .PlotArea.Height) / 2
        End With

        Counter = Counter + 1
    Next zChartSet
End Sub

关键修复说明 #

• 移除Select/Selection：直接通过对象引用操作Chart和Series，避免了Excel交互状态带来的不稳定。
• 调整PlotArea设置顺序：先固定ChartObject的大小，再基于ChartArea的尺寸按比例设置PlotArea，确保PlotArea始终在合理范围内，不会触发Excel的强制自动调整。
• 简化Series创建流程：直接创建需要的两个Series，跳过了先加载数据源再删除的冗余步骤，减少了自动布局的触发次数。

内容的提问来源于stack exchange，提问作者Jrules80