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

时间:2017-12-22 07:17:32

标签: vba excel-vba powerpoint-vba excel

我有一个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

1 个答案:

答案 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