如何用vba创建气泡图？

在 如何在excel中用vba创建图表? 一文中我们介绍了用vba创建图表的基本步骤和通用代码。

但是如果用上文中的代码创建的气泡图是错的，默认会创建多个系列的杂乱无章的气泡图。

气泡图主要用于对比三组数据，其中一组数据用于显示气泡的大小，另外两组数据分别显示X轴和Y轴对应的值。

在用vba创建气泡图时，X值和Y值以及气泡的大小三组值的设置至关重用，如果设置错了，创建的气泡图就会出错。

Series对象的XValues、Values、BubbleSizes属性分别表示X值、Y值、气泡的大小。

其中XValues、Values、BubbleSizes 属性可以指定单元格区域，也可以是常量数组。

接下来我们看看如何用vba创建如下图所示的气泡图：

Sub QQ1722187970()
    '创建内嵌的图表
    Dim oChart As Chart
    Dim oWK As Worksheet
    Dim oChartObject As ChartObject
    Set oWK = Excel.Worksheets("Sheet1")
    iRow = oWK.Range("a65536").End(xlUp).Row
    Dim oSeries As Series
    Dim oSC As SeriesCollection
    Dim oFSC As FullSeriesCollection
    '先创建一个空白的图形壳
    Set oChartObject = oWK.ChartObjects.Add(100, 50, 500, 300)
    Set oChart = oChartObject.Chart
    '对空白的图形进行设置
    With oChart
        '先创建一个气泡图模板，但是这个气泡图是错的。
        .ChartWizard Source:=oWK.Range("a2:c" & iRow), gallery:=xlBubble3DEffect, PlotBy:=xlColumns, HasLegend:=False
        '删除所有的系列
        iCount = .FullSeriesCollection.Count
            For i = .FullSeriesCollection.Count To 2 Step -1
                .FullSeriesCollection(i).Delete
            Next i
        '新建一个空白系列
        Set oSeries = .SeriesCollection.NewSeries
        With oSeries
            '设置系列的名称
            .Name = "序列1"
            '设置X值
            .XValues = oWK.Range("a2:a" & iRow)
            '设置Y值
            .Values = oWK.Range("b2:b" & iRow)
            '设置气泡大小
            .BubbleSizes = oWK.Range("c2:c" & iRow)
        End With
    End With
End Sub

以上代码展示的是创建单系列气泡图。

用上述方式创建的是单系列3D气泡图，如果要创建单系列的非3D气泡图，可以使用如下的代码：

Sub QQ1722187970()
    '创建内嵌的图表
    Dim oChart As Chart
    Dim oWK As Worksheet
    Dim oAZ As Axis
    Dim oAH As Axis
    Dim oChartObject As ChartObject
    For Each oWK In Excel.Worksheets
    '删除原来的图表
    Dim oSP As Shape
    For Each oSP In oWK.Shapes
        oSP.Delete
    Next
    irow = oWK.Range("a65536").End(xlUp).Row
    iX = Excel.Application.WorksheetFunction.Average(oWK.Range("b2:b" & irow))
    iY = Excel.Application.WorksheetFunction.Average(oWK.Range("c2:c" & irow))
    oWK.Range("b" & irow + 1) = iX
    oWK.Range("c" & irow + 1) = iY
    Dim oSeries As Series
    Dim oSC As SeriesCollection
    Dim oFSC As FullSeriesCollection
    '先创建一个空白的图形壳
    Set oChartObject = oWK.ChartObjects.Add(100, 50, 500, 300)
    Set oChart = oChartObject.Chart
    '对空白的图形进行设置
    With oChart
        '先创建一个气泡图模板，但是这个气泡图是错的。
        .ChartWizard Source:=oWK.Range("b2:d" & irow), gallery:=xlBubble3DEffect, PlotBy:=xlColumns, HasLegend:=False
        '删除所有的系列
        iCount = .SeriesCollection.Count
            For i = .SeriesCollection.Count To 1 Step -1
                .SeriesCollection(i).Delete
            Next i
        '新建一个空白系列
        Set oSeries = .SeriesCollection.NewSeries
        With oSeries
            '设置系列的名称
            .Name = ""
            '设置X值
            .XValues = oWK.Range("b2:b" & irow)
            '设置Y值
            .Values = oWK.Range("c2:c" & irow)
            '设置气泡大小
            .BubbleSizes = oWK.Range("d2:d" & irow)
        End With
        '显示数据标签
        .SetElement (msoElementDataLabelCenter)
        .ChartType = xlBubble
        .ClearToMatchStyle
        .ChartStyle = 274
          '设置纵坐标
        Set oAZ = .Axes(xlValue, xlPrimary)
        With oAZ
            .HasMajorGridlines = False
            '坐标轴的大单位
            .MajorUnit = 10
            '坐标轴的小单位
            .MinorUnit = 5
            '最小刻度值
            .MinimumScale = 0
            '最大刻度值
            .MaximumScale = 100
            '横坐标交叉于纵坐标的具体刻度值
            .MinorTickMark = xlTickMarkNone
            .MajorTickMark = xlTickMarkOutside
            .TickLabelPosition = xlTickLabelPositionNextToAxis
            .CrossesAt = iY
            Set oTL = .TickLabels
            '设置坐标轴的数值标记的数值格式
            With oTL
                .NumberFormat = "0"
            End With
        End With
        '设置横坐标
        Set oAH = .Axes(xlCategory, xlPrimary)
        With oAH
            .HasMajorGridlines = False
           .MinorTickMark = xlTickMarkNone
            .MajorTickMark = xlTickMarkOutside
            .TickLabelPosition = xlTickLabelPositionNextToAxis
             .CrossesAt = iX
             Set oTL = .TickLabels
            '设置坐标轴的数值标记的数值格式
            With oTL
                .NumberFormat = "0"
            End With
        End With
    '隐藏图表中的所有数据标签
    .ApplyDataLabels xlDataLabelsShowNone
    '依数据掉着色
    .ChartGroups(1).VaryByCategories = True
    End With
    Next
End Sub