VBA生成图表问题求教

高飞扬

Test.zip (63.5 KB, 下载次数: 26)

2016-7-2 13:43 上传

点击文件名下载附件

见附件，
求助：
该工作簿的自动生成图表，我做了一个单个生成的，只能做到最后有数据没有图表的地方。也就是新加了20条数据后，生成一个图表。
   我想能不能，把该工作表中的数据一次性自动生成一个个的图表（结果见“需要的结果”工作表）？这个问题求教一下！
D列的每组1-20的为一组数据，数据源为I核K列。

蓝桥玄霜

请见代码。

高飞扬

Test2.zip (65.9 KB, 下载次数: 13)

2016-7-2 16:55 上传

点击文件名下载附件

不知道我哪里错了，为什么会出现图中的 .FullSeriesCollection(2).Name = "='需要的结果'!$K$3" 这句报错，
另外就是图表出来后，最底下多了一个。求解！

蓝桥玄霜

1. Sub lqxs()
   
2. Dim mychart As ChartObject, Arr, i&, lf, tp, wd, ht, bt$
   
3. ActiveSheet.ChartObjects.Delete
   
4. bt = "0.4#注射针最大穿刺力": Rows(2).ClearContents
   
5. Arr = [a3].CurrentRegion
   
6. For i = 2 To UBound(Arr) Step 20
   
7.     lf = [l4].Left: tp = Cells(i + 2, 12).Top
   
8.     wd = [l4:t4].Width: ht = Cells(i + 2, 12).Resize(20, 1).Height
   
9.     Set mychart = ActiveSheet.ChartObjects.Add _
   
10.         (Left:=lf, Top:=tp, Width:=wd, Height:=ht)
    
11.     With mychart.Chart
    
12.         .ChartType = xlLine
    
13.         .SetSourceData Source:=Range("$I" & i + 2 & ":$I$" & i + 19 & ",$K$" & i + 2 & ":$K$" & i + 19)
    
14.         .FullSeriesCollection(1).Name = "='" & ActiveSheet.Name & "'!$I$3"
    
15.         .FullSeriesCollection(2).Name = "='" & ActiveSheet.Name & "'!$K$3"
    
16.         .HasLegend = True
    
17.         .Legend.Position = xlLegendPositionBottom
    
18.         .HasTitle = True
    
19.         .ChartTitle.Text = bt
    
20.     End With
    
21. Next
    
22.         
    
23. End Sub
    
24. 
    

复制代码

高飞扬

谢谢蓝版主，圆满的解决了问题！学习了！

HUA79100101

VBA生成图表