VBA修改PPT图表数据源

轮回. · 发表于 2012-5-3 13:29

Excel中可以用如下语句动态修改图表的数据源：
ActiveSheet.ChartObjects("Chart 1").Activate
ActiveChart.SetSourceData Source:=Range("J3:O8")

请问在PPT中的图表，用VBA怎么来动态修改数据源？

轮回. · 发表于 2012-5-3 14:09

我自己试了下，如果在PPT中插入Object中的Microsoft Office Excel Chart，可以获取这个对象的Sheet并修改。
但Chart的对象不知道怎么获取
[code=vb]Sub CommandButton1_Click()
With ActivePresentation.Slides(1)
      Dim i As Integer, j As Integer
      Dim strObjectName
      '获取嵌入对象的名称
      For i = 1 To .Shapes.Count
         If .Shapes(i).Type = msoEmbeddedOLEObject Then
            strObjectName = .Shapes(i).Name
         End If
      Next i
      Dim objShapes As Object ''嵌入的对象
      Dim objChart As Object  ''图表对象
      Dim objSheet As Object  ''Sheet对象

      Set objShapes = .Shapes(strObjectName).OLEFormat.Object

      objShapes.Worksheets("Sheet1").Cells(1, 7) = "Test"
End With
End Sub[/code]

莫悠悠 · 发表于 2012-5-9 16:25

怎么不上传个附件看看？

ning84 · 发表于 2023-1-19 10:52

Sub del()
Dim Present As Presentation, Sld As Slide, Shp As PowerPoint.Shape
Dim Sht As Worksheet
Dim oChart As Chart
Dim ObjShp 'As Object
Dim Str
Set Present = Application.ActivePresentation
For Each Sld In Present.Slides
For Each Shp In Sld.Shapes
If Shp.Type = msoEmbeddedOLEObject Then
Debug.Print Shp.Name, Shp.Type
Str = Shp.Name
Set ObjShp = Sld.Shapes(Shp.Name).OLEFormat.Object
'Set Sht = ObjShp.Worksheets("数据表")
Debug.Print ObjShp.Type
Debug.Print ObjShp.Type = msoEmbeddedOLEObject
Debug.Print Shp.Type = msoEmbeddedOLEObject
Debug.Print ObjShp.Type = msoLinkedOLEObject
Stop
Debug.Print ObjShp.Worksheets("sheet1").Cells(2, 1)
Stop
Stop
Stop
End If
Next Shp
Next Sld
Stop
End Sub

复制代码

现在关键点掌握，如何获取worksheet的数据。

ning84 · 发表于 2023-1-19 21:48

Sub del()
Dim Present As Presentation
Dim Sld As Slide, Shp As Shape
Set Present = Application.ActivePresentation
For Each Sld In Present.Slides
For Each Shp In Sld.Shapes
If Shp.Type = msoEmbeddedOLEObject Then
Debug.Print Shp.Application.Name, Shp.Type
Set objShapes = Sld.Shapes(Shp.Name).OLEFormat.Object
objShapes.Worksheets("Sheet1").Cells(1, 1) = 90
End If
Next Shp
Next Sld
End Sub

复制代码

关键点是要搞清楚
objShapes.Worksheets("Sheet1").Cells(1, 1) = 90
如何定义ObjShapes是什么类型。

ning84 · 发表于 2023-1-20 07:36

Sub del()
Dim Present As Presentation
Dim Sld As Slide, Shp As Shape
Dim xlWk As Workbook
Dim Sht As Worksheet
Set Present = Application.ActivePresentation
For Each Sld In Present.Slides
For Each Shp In Sld.Shapes
If Shp.Type = msoEmbeddedOLEObject Then
Debug.Print Shp.Application.Name, Shp.Type
Set xlWk = Sld.Shapes(Shp.Name).OLEFormat.Object
Set Sht = xlWk.Worksheets("Sheet1")
Sht.Cells(1, 1) = 90
Debug.Print Shp.OLEFormat.Object.Application.Name
End If
Next Shp
Next Sld
End Sub

复制代码

找到了定义的类型，Dim xlWk As Workbook，编程就变得简单了。

		自动登录	找回密码
密码			免费注册

[求助] VBA修改PPT图表数据源