Excel VBA_批量自动制图表实例集锦VIP免费

1,自动生成图表‘http://club.excelhome.net/thread-1058346-1-1.html‘统计报告0925a.xls‘2013-9-25Sublqxs()DimArr,ks,js,nm1$,nm2$,dz1$,dz2$Dimdz$,dz3$,yy$,nm$Application.ScreenUpdating=FalseSheet3.ActivateArr=[a1].CurrentRegionks=3:js=UBound(Arr)-1nm=Sheet3.Nameyy=Left(nm,Len(nm)-3)nm1="图表6"nm2="图表4"dz="A2:B"&js&",D2:E"&jsActiveSheet.ChartObjects(nm1).ActivateWithActiveChart.SetSourceDataSource:=Sheets(nm).Range(dz),PlotBy:=xlColumns.SeriesCollection(1).Selectdz1="R3C2:R"&js&"C2".SeriesCollection(1).Values="='"&nm&"'!"&dz1dz2="R3C4:R"&js&"C4".SeriesCollection(2).Values="='"&nm&"'!"&dz2dz3="R3C5:R"&js&"C5".SeriesCollection(3).Values="='"&nm&"'!"&dz3.ChartTitle.SelectSelection.Characters.Text=yy&"月份合格率"EndWithActiveSheet.ChartObjects(nm2).ActivateWithActiveChart.ChartArea.Selectdz="H2:T2,H"&js+1&":T"&js+1.SetSourceDataSource:=Sheets(nm).Range(dz),PlotBy:=_xlRowsdz2="R"&js+1&"C8:R"&js+1&"C20".SeriesCollection(1).Values="='"&nm&"'!"&dz2.ChartTitle.SelectSelection.Characters.Text=yy&"月份不良趋势统计"EndWithRange("A"&ks).SelectApplication.ScreenUpdating=TrueMsgBox"OK"EndSub2,批量插入图表‘2010-9-27‘批量绘图表.xlsSubChartsAdd()DimmyChartAsChartObjectDimiAsIntegerDimRAsIntegerDimmAsIntegerR=Sheet1.Range("A65536").End(xlUp).Row-1m=Abs(Int(-(R/4)))Sheet2.ChartObjects.DeleteFori=1ToRSetmyChart=Sheet2.ChartObjects.Add_(Left:=(((i-1)Modm)+1)*350-320,_Top:=((i-1)\m+1)*220-210,_Width:=330,Height:=210)WithmyChart.Chart.ChartType=xlColumnClustered.SetSourceDataSource:=Sheet1.Range("B2:M2").Offset(i-1),_PlotBy:=xlRowsWith.SeriesCollection(1).XValues=Sheet1.Range("B1:M1").Name=Sheet1.Range("A2").Offset(i-1).ApplyDataLabelsAutoText:=True,ShowValue:=True.DataLabels.Font.Size=10EndWith.HasLegend=FalseWith.ChartTitle.Left=5.Top=1.Font.Size=14.Font.Name="华文行楷"EndWithWith.PlotArea.Interior.ColorIndex=2.PatternColorIndex=1.Pattern=xlSolidEndWith.Axes(xlCategory).TickLabels.Font.Size=10.Axes(xlValue).TickLabels.Font.Size=10EndWithNextSheet2.SelectSetmyChart=NothingEndSub3,批量插入图表‘2013-9-30‘http://club.excelhome.net/forum.php?mod=viewthread&tid=1059674&page=1#pid7221588SubOpenFiles()DimmyXAsRangeDimmyYAsRangeDimi%,j&Application.ScreenUpdating=FalseActiveSheet.ChartObjects("图表1").ActivateFori=1ToActiveChart.SeriesCollection.Count‘序列集合对象的用法ActiveChart.SeriesCollection(i).Delete‘删除原有的序列NextWithActiveChart.Axes(xlCategory).MaximumScale=100.MinimumScale=0.MajorUnit=20.MinorUnit=4EndWithWithActiveChart.ChartType=xlXYScatterLinesNoMarkers‘散点图Fori=1ToSheet1.Range("IV1").End(xlToLeft).Column+1Step2j=Sheet1.Range("A65536").Offset(0,i-1).End(xlUp).RowSetmyX=Sheet1.Cells(4,i).Resize(j-3,1)SetmyY=myX.Offset(0,1)With.SeriesCollection.NewSeries.Values=myY.XValues=myX.Name=Sheet1.Cells(1,i).Value‘序列名.MarkerStyle=-4142‘没有标志显示EndWithNextiEndWith[a1].SelectApplication.ScreenUpdating=TrueEndSub4,图表对象您可以结合使用Add方法和ChartWizard方法，添加包含工作表数据的新图表。本示例将基于名为Sheet1的工作表上单元格A1:A20中的数据添加一个新的折线图。WithCharts.Add.ChartWizardsource:=Worksheets("Sheet1").Range("A1:A20"),_Gallery:=xlLine,Title:="FebruaryData"EndWithChartObject对象充当Chart对象的容器。ChartObject对象的属性和方法控制工作表上嵌入图表的外观和大小。ChartObject对象是ChartObjects集合的成员。ChartObjects集合包含单一工作表上的所有嵌入图表。使用ChartObjects(index)（其...