Excel VBA批量自动制图表实例集锦文档格式.docx
《Excel VBA批量自动制图表实例集锦文档格式.docx》由会员分享，可在线阅读，更多相关《Excel VBA批量自动制图表实例集锦文档格式.docx（18页珍藏版）》请在冰点文库上搜索。
='
"
nm&
'
!
dz1
dz2="
R3C4:
C4"
.SeriesCollection
（2）.Values="
dz2
dz3="
R3C5:
C5"
.SeriesCollection（3）.Values="
dz3
.ChartTitle.Select
=yy&
月份合格率"
EndWith
ActiveSheet.ChartObjects（nm2）.Activate
.ChartArea.Select
H2:
T2,H"
js+1&
:
T"
js+1
=_
xlRows
C8:
C20"
月份不良趋势统计"
Range（"
A"
ks）.Select
Application.ScreenUpdating=True
MsgBox"
OK"
EndSub
2,批量插入图表
‘2010-9-27
‘批量绘图表.xls
SubChartsAdd（）
DimmyChartAsChartObject
DimiAsInteger
DimRAsInteger
DimmAsInteger
R=Sheet1.Range（"
A65536"
）.End（xlUp）.Row-1
m=Abs（Int（-（R/4）））
Fori=1ToR
SetmyChart=_
（Left:
=（（（i-1）Modm）+1）*350-320,_
Top:
=（（i-1）\m+1）*220-210,_
Width:
=330,Height:
=210）
WithmyChart.Chart
.ChartType=xlColumnClustered
=Sheet1.Range（"
B2:
M2"
）.Offset（i-1）,_
PlotBy:
=xlRows
With.SeriesCollection
（1）
.XValues=Sheet1.Range（"
B1:
M1"
）
.Name=Sheet1.Range（"
A2"
）.Offset（i-1）
.ApplyDataLabelsAutoText:
=True,ShowValue:
=True
.=10
.HasLegend=False
With.ChartTitle
.Left=5
.Top=1
.Font.Size=14
.Font.Name="
华文行楷"
With.PlotArea.Interior
.ColorIndex=2
.PatternColorIndex=1
.Pattern=xlSolid
.Axes（xlCategory）.=10
.Axes（xlValue）.=10
Next
Sheet2.Select
SetmyChart=Nothing
3,批量插入图表
‘2013-9-30
‘#pid7221588
SubOpenFiles（）
DimmyXAsRange
DimmyYAsRange
Dimi%,j&
ActiveSheet.ChartObjects（"
图表1"
）.Activate
Fori=1To‘序列集合对象的用法
ActiveChart.SeriesCollection（i）.Delete‘删除原有的序列
Next
WithActiveChart.Axes（xlCategory）
.MaximumScale=100
.MinimumScale=0
.MajorUnit=20
.MinorUnit=4
EndWith
WithActiveChart
.ChartType=xlXYScatterLinesNoMarkers‘散点图
Fori=1ToSheet1.Range（"
IV1"
）.End（xlToLeft）.Column+1Step2
j=Sheet1.Range（"
）.Offset（0,i-1）.End（xlUp）.Row
SetmyX=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‘没有标志显示
Nexti
[a1].Select
4,图表对象
您可以结合使用Add方法和ChartWizard方法，添加包含工作表数据的新图表。
本示例将基于名为Sheet1的工作表上单元格A1:
A20中的数据添加一个新的折线图。
WithCharts.Add
.ChartWizardsource:
=Worksheets（"
Sheet1"
）.Range（"
A1:
A20"
）,_
Gallery:
=xlLine,Title:
="
FebruaryData"
ChartObject对象充当Chart对象的容器。
ChartObject对象的属性和方法控制工作表上嵌入图表的外观和大小。
ChartObject对象是ChartObjects集合的成员。
ChartObjects集合包含单一工作表上的所有嵌入图表。
使用ChartObjects（index）（其中index是嵌入图表的索引号或名称）可以返回单个ChartObject对象。
示例
以下示例设置名为“Sheet1”的工作表上嵌入图表Chart1中的图表区图案。
Worksheets（"
）.ChartObjects
（1）.Chart._
=msoPatternLightDownwardDiagonal
当选定嵌入图表时，其名称显示在“名称”框中。
使用Name属性可设置或返回ChartObject对象的名称。
以下示例对工作表“Sheet1”上的嵌入图表“Chart1”使用了圆角。
sheet1"
）.ChartObjects（"
chart1"
）.RoundedCorners=True
5,保持图表位置居中by:
Lee1892
‘2013-12-03
PrivateSubKeepSquare（）
DimdXDiff#,dYDiff#,dDiff#
DimdXMin#,dXMax#,dYMin#,dYMax#
WithChartObjects
（1）.Chart
With.Axes（xlCategory）
.MaximumScaleIsAuto=True
.MinimumScaleIsAuto=True
dXMax=.MaximumScale:
dXMin=.MinimumScale
dXDiff=dXMax-dXMin
With.Axes（xlValue）
dYMax=.MaximumScale:
dYMin=.MinimumScale
dYDiff=dYMax-dYMin
dDiff=dXDiff
IfdXDiff<
dYDiffThendDiff=dYDiff
.MaximumScale=dXMax+（dDiff-dXDiff）/2
.MinimumScale=dXMin-（dDiff-dXDiff）/2
.MaximumScale=dYMax+（dDiff-dYDiff）/2
.MinimumScale=dYMin-（dDiff-dYDiff）/2
6,分表，修改数据序列公式
‘-1100811-1-1.html
DimShtAsWorksheet,Sht1AsWorksheet
DimArr,i&
r%,Arr1（）,ks,js,nm$
Application.DisplayAlerts=False
SetSht1=Sheets（"
源表"
Sht1.Activate
ForEachShtInSheets
IfSht.Name<
>
Sht1.NameThenSht.Delete
NextSht
Fori=3ToUBound（Arr）
IfArr（i,1）<
Then
r=r+1
ReDimPreserveArr1（1Tor）
Arr1（r）=i
EndIf
Fori=1Tor
Ifi<
rThen
js=Arr1（i+1）-1
Else
js=UBound（Arr）
ks=Arr1（i）
Sht1.Copyafter:
=Sheets（Sheets.Count）
ActiveSheet.Name=Arr（ks,1）
[a3:
e500].ClearContents
Sht1.Cells（ks,1）.Resize（js-ks+1,5）.Copy[a3]
nm=Arr（ks,1）
ActiveSheet.ChartObjects
（1）.Activate
.FullSeriesCollection
（1）.Select
Selection.Formula="
=SERIES（"
R2C4,"
R3C1:
js-ks+3&
C2,"
C4,1）"
.FullSeriesCollection
（2）.Select
R2C5,"
C5,2）"
.FullSeriesCollection（3）.Delete
Application.DisplayAlerts=True
7,自动制作多图表
‘-919757-1-1.html
‘2012-9-13
R=Int（Sheet1.Range（"
）.End（xlUp）.Row-1）/20
=200,_
=（i-1）*260+20,_
=Cells（20*i-18,1）.Resize（20,2）
‘2014-5-4
‘-1118085-1-1.html
DimMyc%,i&
OnErrorResumeNext
Myc=[iv3].End（xlToLeft）.Column
nm=ActiveSheet.Name
Fori=1ToMycStep8
=Cells（3,i）.Left,_
=Cells（3,i）.Top,_
=Cells（3,i）.Resize（1,7）.Width,Height:
=Cells（3,i）.Resize（16,1）.Height）
.ChartType=xlXYScatterLinesNoMarkers'
散点图
=Cells（550,i+1）.Resize（1351,2）
myChart.Activate
.FullSeriesCollection
（1）.XValues="
Cells（550,i+2）.Resize（1351,1）.Address
.FullSeriesCollection
（1）.Values="
Cells（550,i+1）.Resize（1351,1）.Address
.FullSeriesCollection
（1）.Name="
Cells（2,i+1）.Address
.SeriesCollection.NewSeries
.FullSeriesCollection
（2）.XValues="
Cells（550,i+6）.Resize（1351,1）.Address
.FullSeriesCollection
（2）.Values="
Cells（550,i+5）.Resize（1351,1）.Address
.FullSeriesCollection
（2）.Name="
Cells（2,i+5）.Address
.Axes（xlValue）.MaximumScale=500
.Axes（xlValue）.MinimumScale=-200
.Axes（xlValue）.MajorUnit=100
.Axes（xlValue）.MinorUnit=20.2
.Axes（xlCategory）.MinimumScale=-0.000005
.Axes（xlCategory）.MaximumScale=0.00003
.Axes（xlCategory）.MajorUnit=0.000005
.Axes（xlCategory）.MinorUnit=0.000001
.Legend.Position=xlBottom
.SetElement（msoElementChartTitleAboveChart）
.ChartTitle.Text=Cells（1,i）.Value
With.
.Size=14
8,自动生成图表
‘2014-8-5
‘-1142829-1-1.html
DimMyr&
bt$
Myr=Cells（Rows.Count,1）.End（xlUp）.Row
Left:
=[g3].Left,_
=[g3].Top,_
=[g3].Resize（1,7）.Width,Height:
=[g3].Resize（16,1）.Height
.ChartType=xlXYScatterSmoothNoMarkers
=Sheets（"
CHART"
A3:
Myr）,PlotBy_
:
.SeriesCollection
（1）.XValues="
=CHART!
Myr&
.SeriesCollection
（1）.Name="
R2C2"
.SeriesCollection
（2）.XValues="
C1"
.SeriesCollection
（2）.Name="
R2C1"
.HasTitle=True:
bt=
.=bt
.Axes（xlCategory,xlPrimary）.HasTitle=True
.Axes（xlCategory,xlPrimary）.=
.Axes（xlValue,xlPrimary）.HasTitle=True
.Axes（xlValue,xlPrimary）.=
.Axes（xlValue）.MajorUnit=1
WithSelection.Font
.FontStyle="
加粗"
.Size=18
.PlotArea.Select
WithSelection.Border
.Weight=xlThin
.LineStyle=xlNone
=xlNone
Range（"
a1"
）.Select
9,自动制作多图表
‘2014-9-28
‘-1155286-1-1.html
DimmyChartAsChartObject,Arr,i&
mx,mn,lf
Fori=1ToUBound（Arr,2）
lf=Cells（1,UBound（Arr,2）+2）.Left
mx=Application.Max（Cells（1,i）.Resize（UBound（Arr）,1））
mn=Application.Min（Cells（1,i）.Resize（UBound（Arr）,1））
=lf,Top:
=（i-1）*220+10,_
=450,Height:
.ChartType=xlLine‘折线图
=Cells（1,i）.Resize（UBound（Arr）,1）,_
.HasLegend=True
.HasTitle=False
.Axes（xlValue）.Ma
升级会员 