Excel-VBA-批量自动制图表实例集锦.doc

1, 自动生成图表 ‘/thread-1058346-1-1.html ‘统计报告0925a.xls ‘201 Sub lqxs() Dim Arr, ks, js, nm1$, nm2$, dz1$, dz2$ Dim dz$, dz3$, yy$, nm$ Application.ScreenUpdating = False Sheet3.Activate Arr = [a1].CurrentRegion ks = 3: js = UBound(Arr) - 1 nm = Sheet3.Name yy = Left(nm, Len(nm) - 3) nm1 = 图表 6 nm2 = 图表 4 dz = A2:B js ,D2:E js ActiveSheet.ChartObjects(nm1).Activate With ActiveChart .SetSourceData Source:=Sheets(nm).Range(dz), PlotBy:=xlColumns .SeriesCollection(1).Select dz1 = R3C2:R js C2 .SeriesCollection(1).Values = = nm ! dz1 dz2 = R3C4:R js C4 .SeriesCollection(2).Values = = nm ! dz2 dz3 = R3C5:R js C5 .SeriesCollection(3).Values = = nm ! dz3 .ChartTitle.Select Selection.Characters.Text = yy 月份合格率 End With ActiveSheet.ChartObjects(nm2).Activate With ActiveChart .ChartArea.Select dz = H2:T2,H js + 1 :T js + 1 .SetSourceData Source:=Sheets(nm).Range(dz), PlotBy:= _ xlRows dz2 = R js + 1 C8:R js + 1 C20 .SeriesCollection(1).Values = = nm ! dz2 .ChartTitle.Select Selection.Characters.Text = yy 月份不良趋势统计 End With Range(A ks).Select Application.ScreenUpdating = True MsgBox OK End Sub 2, 批量插入图表 ‘201 ‘批量绘图表.xls Sub ChartsAdd() Dim myChart As ChartObject Dim i As Integer Dim R As Integer Dim m As Integer R = Sheet1.Range(A65536).End(xlUp).Row - 1 m = Abs(Int(-(R / 4))) Sheet2.ChartObjects.Delete For i = 1 To R Set myChart = Sheet2.ChartObjects.Add _ (Left:=(((i - 1) Mod m) + 1) * 350 - 320, _ Top:=((i - 1) \ m + 1) * 220 - 210, _ Width:=330, Height:=210) With myChart.Chart .ChartType = xlColumnClustered .SetSourceData Source:=Sheet1.Range(B2:M2).Offset(i - 1), _ PlotBy:=xlRows With .SeriesCollec