使用Excel VBA编辑PowerPoint数据表图表对象

Question

I have a PowerPoint presentation that I need to update through Excel VBA and I am currently stuck at adding data to the datasheet within a chart. Below the code. What this should do is open the PowerPoint presentation through Excel VBA and assuming the Excel is open, take the range from there and paste it in the DataChart.

I'm still fairly new to objects, more so to PowerPoint objects and I can't figure out how to paste it there. The object is a msoEmbeddedOLEObject and the OLEFormat.progID is "MSGraph.Chart.8" which I sadly do not understand.

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

Answer 1

The only answer I've found was to manually convert the charts in the presentation to a newer format. Now the data table can be addressed, but I find it a bit finicky as it creates an Excel instance in PowerPoint. I'm not sure it's the most efficient, but it works. The code to open the PowerPoint presentation remains unchanged.

Below the code:

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