PowerPoint表格迁移至Excel的VBA实现问题：运行时错误'429'排查及遍历需求

Let's break down what's going wrong with your code and fix it step by step, so you can successfully import all tables from your PowerPoint into Excel:

First, Let's Diagnose the Run-time Error '429' #

The main cause of this error is two critical issues in your code:

1. You're creating duplicate PowerPoint instances (objPPT and pptApp), which causes ActiveX conflicts.
2. ActivePresentation is a PowerPoint-specific object—when running code from Excel, it doesn't automatically point to the presentation you opened. You need to reference the pptPres object you explicitly opened instead.

Other Key Issues in Your Code #

• Undefined variables like wbk2 and wsh2 (you declared wbk but never defined wbk2).
• You're creating a new worksheet for every shape (including non-table shapes like text boxes or images), which is inefficient.
• No check to filter only table shapes—you don't want to paste images or text boxes as tables.

Fixed Code to Import PowerPoint Tables into Excel #

Sub ImportPPTablesToExcel()
    Dim pptApp As PowerPoint.Application
    Dim pptPres As PowerPoint.Presentation
    Dim s As PowerPoint.Slide
    Dim sh As PowerPoint.Shape
    Dim wbk As Workbook
    Dim wsh As Worksheet
    Dim nextRow As Long
    
    ' Initialize PowerPoint (reuse running instance if available)
    On Error Resume Next
    Set pptApp = GetObject(, "PowerPoint.Application")
    If Err.Number <> 0 Then
        Set pptApp = CreateObject("PowerPoint.Application")
    End If
    On Error GoTo 0
    pptApp.Visible = True
    
    ' Open your PowerPoint file
    Dim filePath As String
    filePath = "C:\Example.pptx"
    Set pptPres = pptApp.Presentations.Open(filePath)
    
    ' Set target Excel workbook (use ThisWorkbook if code is in your target file)
    Set wbk = ThisWorkbook ' Replace with Workbooks("Test.xlsm") if needed
    
    ' Create a single worksheet to hold all imported tables
    Set wsh = wbk.Worksheets.Add(After:=wbk.Worksheets(wbk.Worksheets.Count))
    wsh.Name = "PPT Tables Import"
    nextRow = 1
    
    ' Loop through each slide in the presentation
    For Each s In pptPres.Slides
        ' Loop through each shape on the slide
        For Each sh In s.Shapes
            ' Only process table shapes (skip non-table objects)
            If sh.Type = msoTable Then
                ' Copy the table from PowerPoint
                sh.Copy
                
                ' Paste to the next available row in Excel (preserve values + formats)
                wsh.Range("A" & nextRow).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
                ' Use xlPasteAll instead if you want to keep full table formatting
                
                ' Add spacing between tables for readability
                nextRow = nextRow + sh.Table.Rows.Count + 2
            End If
        Next sh
    Next s
    
    ' Clean up: close PowerPoint and release objects
    pptPres.Close SaveChanges:=False
    pptApp.Quit
    Set pptPres = Nothing
    Set pptApp = Nothing
    Set wsh = Nothing
    Set wbk = Nothing
    
    MsgBox "All tables imported successfully!", vbInformation
End Sub

Key Improvements Explained #

1. Avoid Duplicate PowerPoint Instances:

   • We use GetObject to reuse an existing PowerPoint window if it's open, which prevents ActiveX conflicts (the root of your 429 error).
   • We reference pptPres (the presentation we opened) instead of ActivePresentation, which is unreliable in Excel VBA.

2. Target Only Table Shapes:

   • The check If sh.Type = msoTable Then ensures we only process actual tables, ignoring other shapes.

3. Organized Pasting:

   • We use a single worksheet with spacing between tables (you can modify this to create a new worksheet per table if preferred—see note below).
   • PasteSpecial lets you control what gets pasted (values/formats vs. full formatting).

4. Clean-up Code:

   • We close PowerPoint and release all objects to avoid leaving background processes running.

Optional: One Worksheet Per Table #

If you want each PowerPoint table on its own Excel worksheet, modify the table-processing section like this:

If sh.Type = msoTable Then
    ' Create a new sheet for each table
    Set wsh = wbk.Worksheets.Add(After:=wbk.Worksheets(wbk.Worksheets.Count))
    wsh.Name = "Slide " & s.SlideIndex & " Table"
    ' Paste the full table with formatting
    sh.Copy
    wsh.Range("A1").PasteSpecial Paste:=xlPasteAll
End If

Important Setup Step #

Before running the code, enable the PowerPoint Object Library in Excel VBA:

1. Open the VBA editor (Alt + F11)
2. Go to Tools > References
3. Check the box for Microsoft PowerPoint XX.X Object Library (XX.X matches your Office version)

内容的提问来源于stack exchange，提问作者Collin O'Kane