用Excel VBA编辑PowerPoint数据表图表对象
用Excel VBA编辑PowerPoint数据表图表对象
提问于 2017-12-22 15:17:32
我有一个需要通过Excel VBA更新的PowerPoint演示文稿，而我目前正忙于将数据添加到图表中的数据表中。代码下面。这应该做的是通过Excel VBA打开PowerPoint演示文稿，并假定Excel已打开，从那里获取范围并将其粘贴到DataChart中。
我对对象还是相当陌生的，对于PowerPoint对象更是如此，我不知道如何将它粘贴到那里。对象是一个msoEmbeddedOLEObject，而OLEFormat.progID是"MSGraph.Chart.8“，遗憾的是我不理解它。
Public sPath As String, sFile As String, sFilePPT As String
Public PPApp As PowerPoint.Application
Public PPPres As PowerPoint.Presentation
Public PPSlide As PowerPoint.Slide
Public PPShape As PowerPoint.Shape
Public PPChart As PowerPoint.Chart
Public PPChartData As PowerPoint.ChartData
Public cTable As Excel.ListObject
Sub OpenPPT()
sPath = ThisWorkbook.Path & "\"
sFilePPT = "Presentation1.pptx"
On Error Resume Next
'==> Check if PowerPoint is running
Set PPApp = GetObject(, "PowerPoint.Application")
If PPApp Is Nothing Then
'==> If PowerPoint is not running, create new instance
Set PPApp = CreateObject("PowerPoint.Application")
'==> and make it visible (PowerPoint must be visible to be used)
PPApp.Visible = True
Set PPPres = PPApp.Presentations.Open(sPath & sFilePPT)
End If
On Error GoTo 0
'==> Reference presentation and slide
On Error Resume Next
'==> If there's at least one presentation, use it
If PPApp.Windows.Count > 0 Then
Set PPPres = PPApp.ActivePresentation
'==> use active slide
Set PPSlide = PPPres.Slides(PPApp.ActiveWindow.Selection.SlideRange.SlideIndex)
Else
MsgBox "PowerPoint Presentation not found"
Exit Sub
End If
On Error GoTo 0
Set PPSlide = Nothing
Set PPPres = Nothing
Set PPApp = Nothing
End Sub
Sub test()
Dim i As Byte
Dim r As Range
Call OpenPPT
Set PPApp = GetObject(, "PowerPoint.Application")
Set PPPres = PPApp.Presentations(1)
Debug.Print PPPres.Name
Set PPSlide = PPPres.Slides(2)
PPSlide.Select
Debug.Print PPSlide.Name
Set PPShape = PPSlide.Shapes(2)
PPShape.Select
If PPShape.OLEFormat.progID = "MSGraph.Chart.8" Then
Set r = Workbooks("Budget_CM11.xlsm").Worksheets("Recap").Range("AQ12:AY17")
r.Copy
'==> I see it opens the DataChart of the Chart for editing
PPShape.OLEFormat.DoVerb 2
'code needed here that should copy the Excel range
'within the PowerPoint Object (Chart?) Data
End If
End Sub回答 1
Stack Overflow用户
发布于 2018-01-08 15:32:01
我找到的唯一答案是手动将演示文稿中的图表转换为较新的格式。现在可以对数据表进行寻址了，但我发现它有点繁琐，因为它在PowerPoint中创建了一个Excel实例。我不确定它是最有效的，但它是有效的。用于打开PowerPoint演示文稿的代码保持不变。
下面的代码：
Option Explicit
Public sPath As String, sFile As String, sFilePPT As String
Public PPApp As PowerPoint.Application
Public PPPres As PowerPoint.Presentation
Public PPSlide As PowerPoint.Slide
Public PPShape As PowerPoint.Shape
Public PPChart As PowerPoint.Chart
Public PPChartData As PowerPoint.ChartData
Sub test()
Application.ScreenUpdating = False
Dim i As Byte
Dim r As Range
Dim wb As Workbook
Dim ws As Worksheet
Call OpenPPT
Set PPApp = GetObject(, "PowerPoint.Application")
Set PPPres = PPApp.Presentations(1)
Set PPSlide = PPPres.Slides(2)
Debug.Print PPSlide.Name
Set PPShape = PPSlide.Shapes(2)
Set PPChart = PPShape.Chart
Set PPChartData = PPChart.ChartData
PPChartData.Activate
Set wb = PPChartData.Workbook
Set ws = wb.Worksheets(1)
Set r = Workbooks("Budget_CM11.xlsm").Worksheets("RECAP").Range("AQ12:AY17")
r.Copy
ws.Range("B2:J7").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
wb.Close True
PPChart.Select
Application.ScreenUpdating = True
End Sub页面原文内容由Stack Overflow提供。腾讯云小微IT领域专用引擎提供翻译支持
原文链接：
https://stackoverflow.com/questions/47937332
复制相关文章
相似问题
腾讯云开发者
