Excel应用-使用VBA自动绘制所有适用类型的Excel图表（代码及效果图）

最新推荐文章于 2024-08-12 16:59:45 发布

预见未来to50

最新推荐文章于 2024-08-12 16:59:45 发布

阅读量2.2w

点赞数 32

分类专栏： Excel技巧及VBA编程（Excel_VBA）学以致用—实用程序（iApps）

本文链接：https://blog.csdn.net/hpdlzu80100/article/details/73157227

版权

Excel技巧及VBA编程（Excel_VBA）同时被 2 个专栏收录

404 篇文章 169 订阅

订阅专栏

学以致用—实用程序（iApps）

94 篇文章 2 订阅

订阅专栏

深夜，没有睡意。因为，再次发现VBA的魅力。

给出一组数据，如下：

可以绘制多少种Excel图表呢？

答案是以下70多种（Excel 2016实测）：

这效果绝对炫酷，熬夜也值了。

以上Excel图表类型见下表，

VBA代码共享给有缘人：

Public Sub MonthlyCalc()
    Application.ScreenUpdating = False
'定义用于循环的整型变量
Dim Itemp As Integer
Dim ChartTypeArray() As Variant
Dim ChartCount As Integer
    For Itemp = 1 To 12
        '计算商品（甲）的销售额合计
        Cells(4, Itemp + 2) = Cells(2, Itemp + 2) * Cells(3, Itemp + 2)
        '计算商品（乙）的销售额合计
        Cells(7, Itemp + 2) = Cells(5, Itemp + 2) * Cells(6, Itemp + 2)
        '计算商品（丙）的销售额合计
        Cells(10, Itemp + 2) = Cells(8, Itemp + 2) * Cells(9, Itemp + 2)
        '计算三种商品总的销售额合计
        Cells(11, Itemp + 2) = Cells(4, Itemp + 2) + Cells(7, Itemp + 2) _
                + Cells(10, Itemp + 2)
    Next Itemp
    
    'ChartTypeArray = Array(xlLineMarkers, xlLineMarkersStacked, xlLineMarkersStacked100)
    'ChartTypeArray = Array(63, 64, 65, 66, 67)
    '88, 89, 90, 91 excluded
    'ChartTypeArray = Array(-4169, -4151, -4120, -4102, -4101, -4100, -4098, 1, 4, 5, 15, 51, 52, 53, 54, 55, 56, 57, 58, 59, 60, 61, 62, 63, 64, 65, 66, 67, 68, 69, 70, 71, 72, 73, 74, 75, 76, 77, 78, 79, 80, 81, 82, 83, 84, 85, 86, 87)
    
    'ChartTypeArray = Array(92, 93, 94, 95, 96, 97, 98, 99, 100, 101, 102, 103, 104, 105, 106, 107, 108, 109, 110, 111, 112)
    ChartTypeArray = Array(-4169, -4151, -4120, -4102, -4101, -4100, -4098, 1, 4, 5, 15, 51, 52, 53, 54, 55, 56, 57, 58, 59, 60, 61, 62, 63, 64, 65, 66, _
                            67, 68, 69, 70, 71, 72, 73, 74, 75, 76, 77, 78, 79, 80, 81, 82, 83, 84, 85, 86, 87, 92, 93, 94, 95, 96, 97, 98, 99, 100, 101, _
                            102, 103, 104, 105, 106, 107, 108, 109, 110, 111, 112)
    
    ChartCount = 1
    Do While (ChartCount <= (UBound(ChartTypeArray) + 1))
        '添加图表
        Charts.Add
        '定义图表类型
        ActiveChart.ChartType = ChartTypeArray(ChartCount - 1)
        '图表数据源
        ActiveChart.SetSourceData Source:=Sheets("chap5_2").Range( _
            "A1:N1,A4:N4,A7:N7,A10:N10"), PlotBy:=xlRows
        '设置图表添加的位置
        ActiveChart.Location Where:=xlLocationAsObject, Name:="charts2"
        With ActiveChart
            '使图表带有“标题”
            .HasTitle = True
            '设置图表“标题”
            .ChartTitle.Characters.Text = ChartTypeArray(ChartCount - 1) & "——月销售情况对比"
            '使图表带有X坐标标题
            '.Axes(xlCategory, xlPrimary).HasTitle = True
            '设置图表X坐标标题
            '.Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "月份"
            '使图表带有Y坐标标题
           ' .Axes(xlValue, xlPrimary).HasTitle = True
            '使图表带有Y坐标标题
           ' .Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "合计(元)"
        End With
        
        With ActiveChart.Parent
           ' .Left = 10 + 368 * (ChartCount - 1) '此处用以修改图表在工作表中的位置
           ' .Top = 200
            .Left = 10 + Int(ChartCount / 15) * 356 '此处用以修改图表在工作表中的位置
            If (ChartCount Mod 15 <> 0) Then
                .Top = 222 * (ChartCount Mod 15)
                Else
                .Top = 222
            End If
        End With

        ChartCount = ChartCount + 1
    Loop
    
    
    Application.ScreenUpdating = True
End Sub