Excel VBA_批量自动制图表实例集锦 下载本文

内容发布更新时间 : 2024/5/19 10:05:25星期一 下面是文章的全部内容请认真阅读。

1, 自动生成图表

‘http://club.excelhome.net/thread-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 = \

ActiveSheet.ChartObjects(nm1).Activate With ActiveChart

.SetSourceData Source:=Sheets(nm).Range(dz), PlotBy:=xlColumns .SeriesCollection(1).Select dz1 = \

.SeriesCollection(1).Values = \ dz2 = \

.SeriesCollection(2).Values = \ dz3 = \

.SeriesCollection(3).Values = \

.ChartTitle.Select

Selection.Characters.Text = yy & \月份合格率\ End With

ActiveSheet.ChartObjects(nm2).Activate With ActiveChart

.ChartArea.Select

dz = \

.SetSourceData Source:=Sheets(nm).Range(dz), PlotBy:= _ xlRows

dz2 = \

.SeriesCollection(1).Values = \ .ChartTitle.Select

Selection.Characters.Text = yy & \月份不良趋势统计\ End With

Range(\

Application.ScreenUpdating = True MsgBox \End Sub

2, 批量插入图表

‘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(\ m = Abs(Int(-(R / 4)))

Sheet2.ChartObjects.Delete For i = 1 To R

Set myChart = Sheet2.ChartObjects.Add _ (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(\ PlotBy:=xlRows

With .SeriesCollection(1)

.XValues = Sheet1.Range(\

.Name = Sheet1.Range(\

.ApplyDataLabels AutoText:=True, ShowValue:=True .DataLabels.Font.Size = 10 End With