关于用excel中数据生成ppt折线图的求助!jiulongpo 老师完美解决！

上清宫主

谢谢您！
    在手工做幻灯片时，当点击“插入图表”时，系统不是要求输入系列1、系列2等等的数据吗。
    我现在需要的就是这些数据用VBA来进行输入的方法。不管是在ppt中的VBA或者是excel中的VBA都行。
    就因为不懂这点，又回到手工状态了。
   
    谢谢了！

dsd999

我的思路是在excel里，用vba实现折线图，然后再拷贝到ppt里，你觉得？

完全脱离excel里的数据，有点复杂。

dsd999

感觉你也会vba，给你发两个链接参考。
http://peltiertech.com/Excel/XL_PPT.html

http://skp.mvps.org/vba.htm

上清宫主

谢谢您！
在此之前就是这样做的。
现在情况有变化，就需要实现此贴发问的目的。敬请您再帮我想想看能实现不。
再次谢谢您！

jiulongpo

数据不规则，有点难度，运行速度也有问题，正慢慢调试。

jiulongpo

匆忙之中，先试一试。
所需演示文稿.zip (48.13 KB, 下载次数: 288)

2010-3-12 18:44 上传

点击文件名下载附件

Dim Myarr()

Sub MylineExcel()
Dim Mypath As String, Myfile As String
Dim Myshe As Object, Myole As Object, Mycha As Object
Dim bta As Integer, btc As Integer, btk As Integer
Dim btb(), hdsz()

Mypath = ActivePresentation.Path   '获得工作路径
Myfile = Dir(Mypath & "\数据源.xls")   '返回一个Excel文件名
If Myfile = "" Then Exit Sub
Set Myshe = GetObject(Mypath & "\数据源.xls").worksheets("sheet1")
Myarr = Myshe.UsedRange.Value     '数组赋值
Set Myshe = Nothing     '清空对象

a = 0
bta = 1
btc = UBound(Myarr, 1)
btk = UBound(Myarr, 2)
ReDim Preserve btb(0)
btb(0) = 1

For i = 1 To btc     '该循环为取得"小计"的行
   If Myarr(i, 1) Like "*小计*" Then
      a = a + 1
      ReDim Preserve btb(a)
      btb(a) = i
   End If
Next i

For i = ActivePresentation.Slides.Count To 1 Step -1     '该循环删除所有幻灯片
   ActivePresentation.Slides(i).Delete
Next i

For i = 1 To UBound(btb)
For k = 2 To UBound(Myarr, 2)
Set mynewslide = ActivePresentation.Slides.Add(Index:=ActivePresentation.Slides.Count + 1, Layout:=ppLayoutBlank)     '添加幻灯片
Set Myole = mynewslide.Shapes.AddOLEObject _
              (Left:=10, Top:=10, Width:=700, Height:=500, ClassName:="MSGraph.Chart", Link:=msoTrue)     '添加嵌入图表,设置对象
   Myole.Name = "Mychart" & 1      '设置图表名称
   Set Mycha = Myole.OLEFormat.Object     '设置对象
   Mycha.ChartType = 65     '图表类型为_数据点折线图
   Mycha.Application.PlotBy = 2     '图表产生在列上
   Mycha.Parent.datasheet.Cells.Clear     '清除图表数据表中所有数据
   hdsz = scsz(btb(i - 1), btb(i), k)     '取得所需的数据数组
   For ro = 1 To UBound(hdsz, 1)     '该循环给图表数据表加入数据
   For co = 1 To UBound(hdsz, 2)
      Mycha.Parent.datasheet.Cells(ro, co) = hdsz(ro, co)     '给图表数据表加入数据
   Next co
   Next ro
Next k
Next i

End Sub

Function scsz(ByVal fw1 As Integer, ByVal fw2 As Integer, ByVal b1 As Integer)     '取得所需的数据数组
Dim t1 As Integer
Dim sjsz()
ReDim sjsz(1 To fw2 - fw1, 1 To 4)

sjsz(1, 1) = ""
sjsz(1, 2) = Myarr(1, b1)
sjsz(1, 3) = Myarr(fw2, 1)
sjsz(1, 4) = Myarr(UBound(Myarr, 1), 1)

t1 = 2
For i = fw1 + 1 To fw2 - 1
   sjsz(t1, 1) = Myarr(i, 1)
   sjsz(t1, 2) = Myarr(i, b1)
   sjsz(t1, 3) = Myarr(fw2, b1)
   sjsz(t1, 4) = Myarr(UBound(Myarr, 1), b1)
   t1 = t1 + 1
Next i

scsz = sjsz
End Function

上清宫主

太好了！
感动！
实在太好了！
终于看到了！
谢谢您！jiulongpo 老师！！！

上清宫主

学习了，datasheet，就是他。
再次感谢jiulongpo 老师！！！
祝
好！

ares_sheng

jiulongpo老师真神人也！！

莫悠悠

jiulongpo 发表于 2010-3-12 18:44
匆忙之中，先试一试。[em07] [em07]

Dim Myarr()

多出了几张东部北部西部的数据是咋回事呢？困惑中……