我有一个PowerPoint演示文稿,我需要通过Excel VBA更新,我目前停留在图表中的数据表中添加数据。代码下方。这应该做的是通过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
答案 0 :(得分:0)
我发现的唯一答案是手动将演示文稿中的图表转换为更新的格式。现在可以解决数据表,但我发现它有点挑剔,因为它在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