批量添加图表 | 易学教程

'MASS CREATE CHART
Sub Mass_Create_Chart()
Dim oChart As ChartObject
Dim m1%, m2%, j%
Dim title_1, title_2
Dim rng_1, rng_2, rng_x

Dim nChart As New Chart
Dim iTop As Integer, iLeft As Integer
Dim iCount As Integer

iTop = 170                   'INITIAL TOP
iLeft = 20                    'INITIAL LEFT

With Sheets("Summary")
    'DELETE PREVIOUS CHARTS
    For Each oChart In .ChartObjects
        oChart.Delete
    Next
    
    'CREATE CHART
    For m1 = 2 To 9
        iCount = iCount + 1
        'GET BASE ROW
        If m1 = 9 Then m2 = 12 Else m2 = 11
        'GET DATA INFORMATION
        title_1 = .Cells(m1, 1).Text & "-" & .Cells(m1, 2).Text
        title_2 = .Cells(m2, 1).Text & "-" & .Cells(m2, 2).Text
        
        Set rng_1 = .Range(.Cells(m1, 3), .Cells(m1, 11))
        Set rng_2 = .Range(.Cells(m2, 3), .Cells(m2, 11))
        Set rng_x = .Range(.Cells(1, 3), .Cells(1, 11))
        
        'CREATE NEW CHART
        Set nChart = .ChartObjects.Add(Width:=350, Height:=200, Top:=iTop, Left:=iLeft).Chart
        With nChart
            .Parent.Name = "Chrt_" & m1
            .ChartArea.Format.TextFrame2.TextRange.Font.Name = "Source Code Pro"
            .ChartType = xlColumnClustered
            .HasTitle = False
            .Legend.Position = xlLegendPositionTop
            .Axes(xlValue).MajorGridlines.Delete
            'NEW SERIES FOR NEW CHART
            Set nSeries = .SeriesCollection.NewSeries
            With nSeries
                .Name = title_1
                .Values = rng_1
                .XValues = rng_x
            End With
            'NEW SERIES FOR NEW CHART
            Set nSeries = .SeriesCollection.NewSeries
            With nSeries
                .Name = title_2
                .XValues = rng_x
                .Values = rng_2
                .ChartType = xlLine
            End With
            .SeriesCollection(1).HasDataLabels = True
        End With
        'CONTROL THE CHART POSITION
        If iCount Mod 4 = 0 Then
            iTop = 170
            iLeft = iLeft + 350 + 20
        Else
            iTop = iTop + 200
        End If
    Next m1
End With
Debug.Print Date, Time
End Sub
来源：oschina
链接：https://my.oschina.net/tedzheng/blog/3223362
标签
chart
dim
cells