ExcelVBA_批量自动制图表实例集锦.docx

PAGE PAGE # 自动生成图表 -1058346-1-1.html 统计报告 0925a.xls ‘2013-9-25 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 = 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 = yy 月份不良趋势统计 End With Range(A ks).Select Applicati on. Scree nU pdat ing = True MsgBox OK End Sub 8月粉不良趋势统计250020001EOO1000 8月粉不良趋势统计 2500 2000 1EOO 1000 500 0 98 50% 96 00% 97.50% 97.00% 96.50% 96 ￡0% 95 50% 95.00% 94 50% 94.00% 批量插入图表 ‘2010-9-27 ‘批量绘图表 .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))) For i = 1 To R Set myChart = _ (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 .SeriesCollection(1) .XValues = Sheet1.Range(B1:M1) .Name = Sheet1.Range(A2).Offset(i - 1) .ApplyDataLabels AutoText:=True, ShowValue:=True . = 10 End With .HasLegend = False With .ChartTitle .Left = 5 .Top = 1 .Font.Size = 14 .Font.Name = 华文行楷 End With With .PlotArea.Interior .ColorIndex = 2 .PatternColorIndex =