《excel vba_批量自动制图表实例集锦》由会员分享，可在线阅读，更多相关《excel vba_批量自动制图表实例集锦（13页珍藏版）》请在金锄头文库上搜索。
1、1, 自自动动生成生成图图表表 http:/ 统计报告 0925a.xls2013-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) - 1nm = Sheet3.Nameyy = Left(nm, Len(nm) - 3)nm1 = “图表 6“nm2 = “图表 4“dz = “A2:B
2、“ & js & “,D2:E“ & jsActiveSheet.ChartObjects(nm1).ActivateWith ActiveChart.SetSourceData Source:=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 = “=“
3、& nm & “!“ & dz2dz3 = “R3C5:R“ & js & “C5“.SeriesCollection(3).Values = “=“ & nm & “!“ & dz3.ChartTitle.SelectSelection.Characters.Text = yy & “月份合格率“End WithActiveSheet.ChartObjects(nm2).ActivateWith ActiveChart.ChartArea.Selectdz = “H2:T2,H“ & js + 1 & “:T“ & js + 1.SetSourceData Source:=Sheets(nm
4、).Range(dz), PlotBy:= _xlRowsdz2 = “R“ & js + 1 & “C8:R“ & js + 1 & “C20“.SeriesCollection(1).Values = “=“ & nm & “!“ & dz2.ChartTitle.SelectSelection.Characters.Text = yy & “月份不良趋势统计“End With Range(“A“ & ks).SelectApplication.ScreenUpdating = True MsgBox “OK“ End Sub2, 批量插入批量插入图图表表 2010-9-27 批量绘图表.
5、xls Sub ChartsAdd()Dim myChart As ChartObjectDim i As IntegerDim R As IntegerDim m As IntegerR = Sheet1.Range(“A65536“).End(xlUp).Row - 1m = Abs(Int(-(R / 4)Sheet2.ChartObjects.DeleteFor i = 1 To RSet myChart = Sheet2.ChartObjects.Add _(Left:=(i - 1) Mod m) + 1) * 350 - 320, _Top:=(i - 1) m + 1) * 2
6、20 - 210, _Width:=330, Height:=210)With myChart.Chart.ChartType = xlColumnClustered.SetSourceData Source:=Sheet1.Range(“B2:M2“).Offset(i - 1), _PlotBy:=xlRowsWith .SeriesCollection(1).XValues = Sheet1.Range(“B1:M1“).Name = Sheet1.Range(“A2“).Offset(i - 1).ApplyDataLabels AutoText:=True, ShowValue:=T
7、rue.DataLabels.Font.Size = 10End With.HasLegend = FalseWith .ChartTitle.Left = 5.Top = 1.Font.Size = 14.Font.Name = “华文行楷“End WithWith .PlotArea.Interior.ColorIndex = 2.PatternColorIndex = 1.Pattern = xlSolidEnd With.Axes(xlCategory).TickLabels.Font.Size = 10.Axes(xlValue).TickLabels.Font.Size = 10E
8、nd WithNextSheet2.SelectSet myChart = Nothing End Sub3, 批量插入批量插入图图表表 2013-9-30 http:/ OpenFiles() Dim myX As Range Dim myY As Range Dim i%, j& Application.ScreenUpdating = False ActiveSheet.ChartObjects(“图表 1“).Activate For i = 1 To ActiveChart.SeriesCollection.Count 序列集合对象的用法ActiveChart.SeriesColle
9、ction(i).Delete 删除原有的序列 Next With ActiveChart.Axes(xlCategory).MaximumScale = 100.MinimumScale = 0.MajorUnit = 20.MinorUnit = 4 End With With ActiveChart.ChartType = xlXYScatterLinesNoMarkers 散点图For i = 1 To Sheet1.Range(“IV1“).End(xlToLeft).Column + 1 Step 2j = Sheet1.Range(“A65536“).Offset(0, i -
10、1).End(xlUp).RowSet myX = Sheet1.Cells(4, i).Resize(j - 3, 1)Set myY = myX.Offset(0, 1)With .SeriesCollection.NewSeries.Values = myY.XValues = myX.Name = Sheet1.Cells(1, i).Value 序列名.MarkerStyle = -4142 没有标志显示End WithNext i End With a1.Select Application.ScreenUpdating = True End Sub4, 图图表表对对象象 您可以结
11、合使用 Add 方法和 ChartWizard 方法，添加包含工作表数据的新图表。本示例 将基于名为 Sheet1 的工作表上单元格 A1:A20 中的数据添加一个新的折线图。With Charts.Add.ChartWizard source:=Worksheets(“Sheet1“).Range(“A1:A20“), _Gallery:=xlLine, Title:=“February Data“ End WithChartObject 对象充当 Chart 对象的容器。ChartObject 对象的属性和方法控制工作表上嵌 入图表的外观和大小。ChartObject 对象是 ChartO
12、bjects 集合的成员。ChartObjects 集合包含 单一工作表上的所有嵌入图表。使用 ChartObjects(index)（其中 index 是嵌入图表的索引号或名称）可以返回单个 ChartObject 对象。示例 以下示例设置名为“Sheet1”的工作表上嵌入图表 Chart 1 中的图表区图案。 Worksheets(“Sheet1“).ChartObjects(1).Chart. _ChartArea.Format.Fill.Pattern = msoPatternLightDownwardDiagonal 当选定嵌入图表时，其名称显示在“名称”框中。使用 Name 属性可
13、设置或返回 ChartObject 对象的名称。以下示例对工作表“Sheet1”上的嵌入图表“Chart 1”使用了圆角。Worksheets(“sheet1“).ChartObjects(“chart 1“).RoundedCorners = True 5, 保持保持图图表位置居中表位置居中 by:Lee18922013-12-03 Private Sub KeepSquare()Dim dXDiff#, dYDiff#, dDiff#Dim dXMin#, dXMax#, dYMin#, dYMax#With ChartObjects(1).ChartWith .Axes(xlCatego
14、ry).MaximumScaleIsAuto = True.MinimumScaleIsAuto = TruedXMax = .MaximumScale: dXMin = .MinimumScaledXDiff = dXMax - dXMinEnd WithWith .Axes(xlValue).MaximumScaleIsAuto = True.MinimumScaleIsAuto = TruedYMax = .MaximumScale: dYMin = .MinimumScaledYDiff = dYMax - dYMinEnd WithdDiff = dXDiffIf dXDiff Sh
15、t1.Name Then Sht.Delete Next Sht Arr = a1.CurrentRegion For i = 3 To UBound(Arr)If Arr(i, 1) r Thenjs = Arr1(i + 1) - 1Elsejs = UBound(Arr)End Ifks = Arr1(i)Sht1.Copy after:=Sheets(Sheets.Count)ActiveSheet.Name = Arr(ks, 1)a3:e500.ClearContentsSht1.Cells(ks, 1).Resize(js - ks + 1, 5).Copy a3nm = Arr
16、(ks, 1)ActiveSheet.ChartObjects(1).ActivateWith ActiveChart.SetSourceData Source:=Sheets(nm).Range(dz), PlotBy:=xlColumns.FullSeriesCollection(1).SelectSelection.Formula = “=SERIES(“ & nm & “!R2C4,“ & nm & “!R3C1:R“ & js - ks + 3 & “C2,“ & nm & “!R3C4:R“ & js - ks + 3 & “C4,1)“.FullSeriesCollection(2).SelectSelection.Formula = “
