VBA 将表格从 PowerPoint 复制并粘贴到 Excel

Question

我有包含多个表格的 PowerPoint 文件，我正在尝试编写 excel vba 代码来打开文件，遍历幻灯片和形状，然后将表格传输到 ZBF57C906FA7D2BB66D07372E41585D9Z6。 为此，我只想知道如何循环播放幻灯片并将任何和所有形状/表格转移到 excel。

这是我当前的代码：

Sub PP_Test()
Dim s As Slide
Dim sh As Shape
Dim wbk As Workbook
Dim wsh As Worksheet

 Set objPPT = CreateObject("Powerpoint.application")
 objPPT.Visible = True
 Dim file As String
 file = "C:\Example.pptx"
 Set pptApp = CreateObject("PowerPoint.Application")
 Set pptPres = pptApp.Presentations.Open(file)
 Set wbk = Workbooks("Test.xlsm")

'Loop through the slides and loop through the shapes to find all the Tables. Copy the table, and paste them in Excel
For Each s In ActivePresentation.Slides
For Each sh In s.Shapes
'Create a new sheet in Excel
Set wsh = wbk.Worksheets.Add(After:=wbk2.Worksheets(wbk2.Worksheets.Count))
' Copy/paste the shape/table
sh.Copy
wsh2.Paste
Next sh
Next s

End Sub

我目前在“For Each s In Active Presentation.Slides”行中收到以下运行时错误：运行时错误“429”：ActiveX 组件无法创建 object

我已经四处寻找示例，但我只能找到如何将表格从 excel 传输到 PowerPoint 的示例，而反之则不行。

Answer 1

你的代码有很多问题：

• 您正在混合后期绑定和早期绑定。 虽然这是可能的，但没有任何意义。 我假设您已经添加了对 PowerPoint-Library 的引用（否则Slide类型将无效并且编译器会抱怨），因此无需将objPPT声明为 Object 并使用CreateObject 。 最好将pptApp as PowerPoint.Application并简单地使用new -command。
• 您创建两个 Powerpoint-Aplication 对象（两次调用CreateObject("PowerPoint.Application") ）
• 显然你不使用Option Explicit 。 你应该。 总是。 您将工作簿分配给变量wbk但稍后使用wbk2 。 与wsh与wsh2相同。 让编译器帮你找出这些问题。
• Excel 对ActivePresentation不了解（这就是您的错误的来源）。 您可以使用pptApp.ActivePresentation ，但这不是必需的，因为您已经在pptPres中引用了演示文稿。

假设早期绑定，您的代码可能看起来像

Sub PP_Test()
    Const filename = "C:\Example.pptx"

    Dim wbk As Workbook, wsh As Worksheet
    
    Dim pptApp As PowerPoint.Application, pptPres As PowerPoint.Presentation
    Set pptApp = new PowerPoint.Application
    pptApp.Visible = True
        
    Set pptPres = pptApp.Presentations.Open(filename)
    
    Set wbk = Workbooks("Test.xlsm")
    
    'Loop through the slides and loop through the shapes to find all the Tables. Copy the table, and paste them in Excel
    Dim s As PowerPoint.Slide, sh As PowerPoint.Shape
    For Each s In pptPres.Slides
        For Each sh In s.Shapes
            'Create a new sheet in Excel
            Set wsh = wbk.Worksheets.Add(After:=wbk.Worksheets(wbk.Worksheets.Count))
            ' Copy/paste the shape/table
            sh.Copy
            wsh.Paste
        Next sh
    Next s
End Sub