I have PowerPoint file with multiple tables, and I am trying to write an excel vba code to open the file, loop through the slides and shapes, and then transfer the tables into excel. For this purpose I just want to know how to loop through a slide and transfer any and all shapes/tables to excel.
Here is my current code:
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
I currently get the following Run-Time Error on the line "For Each s In Active Presentation.Slides": Run-time error '429': ActiveX component can't create object
I have looked around for examples, but I can only find examples of how to transfer tables from excel to PowerPoint, but not the other way around.
Lots of problems with your code:
Slide
would be invalid and the compiler would complain), so no need to declare objPPT
as Object and use CreateObject
. It's much better to declare pptApp as PowerPoint.Application
and simply use the new
-command.CreateObject("PowerPoint.Application")
)Option Explicit
. You should. Always. You assign a workbook to the variable wbk
but later use wbk2
. Same with wsh
vs. wsh2
. Let the compiler help you find those problems.ActivePresentation
(and this is where your error comes from). You could use pptApp.ActivePresentation
, but this is not necessary as you have already a reference to the presentation in pptPres
.Assuming early binding , your code could look like
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
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.