ExcelVBA批量自动制图表实例集锦Word格式文档下载.docx
- 文档编号:18488407
- 上传时间:2022-12-17
- 格式:DOCX
- 页数:14
- 大小:365.21KB
ExcelVBA批量自动制图表实例集锦Word格式文档下载.docx
《ExcelVBA批量自动制图表实例集锦Word格式文档下载.docx》由会员分享,可在线阅读,更多相关《ExcelVBA批量自动制图表实例集锦Word格式文档下载.docx(14页珍藏版)》请在冰豆网上搜索。
='
"
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.Selectdz="
H2:
T2,H"
js+1&
:
T"
js+1
=xlRowsdz2="
C8:
C20"
.SeriesCollection
(1).Values="
dz2.ChartTitle.Select
月份不良趋势统计EndWith
Range("
A"
ks).Select
Application.ScreenUpdating=True
MsgBox"
OK"
EndSub
8月粉不良趋势统计
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="
华文行楷"
EndWithWith.PlotArea.Interior
.ColorIndex=2
.PatternColorIndex=1.Pattern=xlSolidEndWith.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‘删除原有的序列
WithActiveChart.Axes(xlCategory)
.MaximumScale=100
.MinimumScale=0
.MajorUnit=20
.MinorUnit=4
.ChartType=xlXYScatterLinesNoMarkers‘散点图
Fori=1ToSheet1.Range("
IV1"
).End(xlToLeft).Column+1Step2j=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
Application.ScreenUpdating=True
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对象。
示例
以下示例设置名为"
Sheetl”的工作表上嵌入图表Chart1中的图表区图案。
Worksheets("
).ChartObjects
(1).Chart._
=msoPatternLightDownwardDiagonal
当选定嵌入图表时,其名称显示在“名称”框中。
使用Name属性可设置或返回ChartObject对象的名称。
以下示例对工作表“Sheetl”上的嵌入图表“Chart1”使用了圆角。
sheet1"
).ChartObjects("
chart1"
).RoundedCorners=True
5,保持图表位置居中by:
Lee1892
‘201-312-03
PrivateSubKeepSquare()
DimdXDiff#,dYDiff#,dDiff#
DimdXMin#,dXMax#,dYMin#,dYMax#
WithChartObjects
(1).Chart
With.Axes(xlCategory).MaximumScaleIsAuto=True.MinimumScaleIsAuto=TruedXMax=.MaximumScale:
dXMin=.MinimumScaledXDiff=dXMax-dXMin
With.Axes(xlValue).MaximumScaleIsAuto=True.MinimumScaleIsAuto=TruedYMax=.MaximumScale:
dYMin=.MinimumScaledYDiff=dYMax-dYMin
dDiff=dXDiff
IfdXDiff<
dYDiffThendDiff=dYDiff
With.Axes(xlCategory)
.MaximumScale=dXMax+(dDiff-dXDiff)/2.MinimumScale=dXMin-(dDiff-dXDiff)/2
With.Axes(xlValue)
.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.ScreenUpdating=FalseApplication.DisplayAlerts=False
SetSht1=Sheets(”源表”)
Sht1.Activate
ForEachShtInSheets
IfSht.Name<
>
Sht1.NameThenSht.Delete
NextSht
Fori=3ToUBound(Arr)
IfArr(i,1)<
Then
r=r+1ReDimPreserveArr1(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
=xlColumns.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)EndWith
‘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)WithmyChart.Chart
.ChartType=xlXYScatterLinesNoMarkers'
散点图
=Cells(550,i+1).Resize(1351,2)EndWith
myChart.Activate
.FullSeriesCollection
(1).Select
.FullSeriesCollection
(1).XValues="
Cells(550,i2).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,i6).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).ValueWith.
.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).HeightActiveSheet.ChartObjects
(1).ActivateWithActiveChart
.ChartType=xlXYScatterSmoothNoMarkers
=Sheets("
CHART"
A3:
Myr),PlotBy_:
=xlColumns
.SeriesCollection.NewSeries
.SeriesCollection
(1).XValues="
=CHART!
Myr&
.SeriesCollection
(1).Name="
R2C2"
.SeriesCollection
(2).XValues="
.SeriesCollection
(2).Values="
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.ChartTitle.SelectWithSelection.Font
.FontStyle="
加粗"
.Size=18
.PlotArea.Select
WithSelection.Border
.Weight=xlThin
.LineStyle=xlNone
=xlNone
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,_Width:
=450,Height:
.ChartType=xlLine‘折线图
=Cells(1,i).Resize(UBound(Arr),1),
.HasLegend=True
.HasTitle=False
.Axes(xlValue).MajorUnit=10‘主要分尺寸
最小值
‘最大值
.Axes(xlValue).MinimumScale=Int((mn-10)/10)*10.Axes(xlValue).MaximumScale=Int((mx+10)/10)*10
10,根据指定级别自动制作多图表
‘2015-4-23
‘-342019-1-1.html
PrivateSubWorksheet_Change(ByValTargetAsRange)
IfTarget.Address<
$O$1"
ThenExitSub
DimArr,i
- 配套讲稿:
如PPT文件的首页显示word图标,表示该PPT已包含配套word讲稿。双击word图标可打开word文档。
- 特殊限制:
部分文档作品中含有的国旗、国徽等图片,仅作为作品整体效果示例展示,禁止商用。设计者仅对作品中独创性部分享有著作权。
- 关 键 词:
- ExcelVBA 批量 自动 制图 实例 集锦