Office2019 Excel VBA实现行列排列指定直径圆形及报错解决

错误原因分析 #

chartObj.Chart.SeriesCollection(1).Points.Add xPos, diameterCell.Value触发1004错误的核心原因是：Points.Add方法不支持直接传入坐标值添加新数据点。该方法仅用于在已有系列的数据源基础上插入空数据点，后续需通过修改系列的XValues/Values数组或更新数据源区域赋值，无法直接传入参数生成新点。

方案1：修复图表系列的添加逻辑 #

若坚持使用图表实现，需先构建包含所有圆形位置、直径的数据源数组，再绑定到图表系列，而非逐个添加点。示例代码如下：

Sub CreateCircleChart()
    Dim ws As Worksheet
    Dim diameterRange As Range
    Dim xValues() As Double, yValues() As Double
    Dim chartObj As ChartObject, seriesObj As Series
    Dim rowMaxCount As Integer, currentCount As Integer
    Dim xPos As Double, yPos As Double, currentRowMaxDiam As Double
    
    Set ws = ActiveSheet
    Set diameterRange = ws.Range("A2:A" & ws.Cells(ws.Rows.Count, "A").End(xlUp).Row) ' 假设直径在A列（A2开始）
    rowMaxCount = 5 ' 自定义每行最大圆形数量，控制整体宽度
    
    ' 初始化数据数组
    ReDim xValues(1 To diameterRange.Cells.Count)
    ReDim yValues(1 To diameterRange.Cells.Count)
    
    currentCount = 0
    yPos = 0
    currentRowMaxDiam = 0
    
    For Each cell In diameterRange
        currentCount = currentCount + 1
        xPos = (currentCount - 1) * (cell.Value + 5) ' 5为圆形间间距
        
        ' 判断是否需要换行
        If currentCount > rowMaxCount Then
            currentCount = 1
            yPos = yPos + currentRowMaxDiam + 5 ' 5为行间距
            currentRowMaxDiam = cell.Value
            xPos = 0
        Else
            If cell.Value > currentRowMaxDiam Then currentRowMaxDiam = cell.Value
        End If
        
        xValues(currentCount + (yPos \ (currentRowMaxDiam + 5)) * rowMaxCount) = xPos
        yValues(currentCount + (yPos \ (currentRowMaxDiam + 5)) * rowMaxCount) = yPos + currentRowMaxDiam / 2 ' Y轴居中
        
    Next cell
    
    ' 创建图表并绑定数据
    Set chartObj = ws.ChartObjects.Add(Left:=100, Top:=100, _
        Width:=rowMaxCount * (Application.Max(diameterRange) + 5), _
        Height:=yPos + currentRowMaxDiam)
    Set seriesObj = chartObj.Chart.SeriesCollection.NewSeries
    
    seriesObj.XValues = xValues
    seriesObj.Values = yValues
    chartObj.Chart.ChartType = xlBubble
    seriesObj.BubbleSizes = diameterRange.Value ' 绑定直径作为气泡大小
    
    ' 隐藏无关元素
    chartObj.Chart.Axes(xlCategory).Delete
    chartObj.Chart.Axes(xlValue).Delete
End Sub

方案2：使用Shape对象绘制圆形（更精准匹配需求） #

相比图表，Shape对象能更灵活控制圆形的位置、大小与排列，完全满足“填满一行换行、自定义宽度、高度为每行最大直径之和”的需求，示例代码：

Sub DrawCirclesWithShape()
    Dim ws As Worksheet
    Dim diameterRange As Range, cell As Range
    Dim rowMaxCount As Integer, currentCount As Integer
    Dim startX As Double, startY As Double, currentX As Double, currentY As Double
    Dim currentRowMaxDiam As Double, circleShape As Shape
    
    Set ws = ActiveSheet
    Set diameterRange = ws.Range("A2:A" & ws.Cells(ws.Rows.Count, "A").End(xlUp).Row) ' 直径列假设为A列
    rowMaxCount = 6 ' 自定义每行最大圆形数量，控制整体宽度
    startX = 50 ' 起始X坐标
    startY = 50 ' 起始Y坐标
    currentX = startX
    currentY = startY
    currentRowMaxDiam = 0
    currentCount = 0
    
    ' 清除已有圆形（可选）
    For Each circleShape In ws.Shapes
        If circleShape.Name Like "Circle_*" Then circleShape.Delete
    Next
    
    For Each cell In diameterRange
        If cell.Value <= 0 Then GoTo NextCell ' 跳过无效直径
        
        currentCount = currentCount + 1
        
        ' 判断是否换行
        If currentCount > rowMaxCount Then
            currentY = currentY + currentRowMaxDiam + 10 ' 10为行间距
            currentX = startX
            currentCount = 1
            currentRowMaxDiam = cell.Value
        Else
            If cell.Value > currentRowMaxDiam Then currentRowMaxDiam = cell.Value
        End If
        
        ' 绘制圆形：调整坐标使圆形垂直居中于当前行
        Set circleShape = ws.Shapes.AddShape(msoShapeOval, _
            currentX, _
            currentY + (currentRowMaxDiam - cell.Value) / 2, _
            cell.Value, _
            cell.Value)
        
        ' 设置圆形属性
        circleShape.Name = "Circle_" & cell.Row
        circleShape.Fill.ForeColor.RGB = RGB(100, 150, 200)
        circleShape.Line.Visible = msoFalse
        
        currentX = currentX + cell.Value + 5 ' 更新下一个圆形的X坐标（5为间距）
        
NextCell:
    Next cell
    
    ' 可选：绘制边框框住所有圆形
    Dim totalWidth As Double, totalHeight As Double
    totalWidth = (rowMaxCount * (Application.Max(diameterRange) + 5)) - 5
    totalHeight = currentY + currentRowMaxDiam - startY
    Set circleShape = ws.Shapes.AddShape(msoShapeRectangle, startX - 5, startY - 5, totalWidth + 10, totalHeight + 10)
    circleShape.Name = "Border"
    circleShape.Fill.Visible = msoFalse
    circleShape.Line.ForeColor.RGB = RGB(0, 0, 0)
End Sub

关键说明 #

• 方案2的Shape方法更贴合需求，可精准控制每个圆形的位置、大小，以及行高（每行高度为该行最大直径），宽度由首行最大圆形数量直接决定。
• 若使用图表方案，气泡图是最优选择，但需注意图表坐标缩放问题，可能需手动调整坐标轴范围避免显示异常。

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