Copy table in powerpoint to excel tabs and rename tabs

[hwong8848]

Hi All!

I have a question regarding looping through all tables and copy them to excel.

Sub PP_Test()
    Const filename = "C:\Users\file.pptm"

    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

However, user defined function error keep pooping up. Is there any quick fix?

 

[mmhill]

It looks fine. Worked when I ran it. I do see that your file names are pptm and xlsm - both macro enabled. You likely have a custom function in one of them that is causing the error. For example, your workbook may have a NewSheet, SheetActivate or SheetDeactive event-driven macro that is not gettig what it needs and throwing an error. Just a guess.

One quick tip - between Next s and End Sub, add lines to clean up. It will keep stray stuff ffom causing problems.

    pptPres.Close: Set pptPres = Nothing
    pptApp.Quit: Set pptApp = Nothing

 

[hwong8848]

Ah - didn't manage to get it fixed.
I manually changed the file type to be both macro enabled as I thought it has to be before I run this.

The problem still persist though, user-defined function error..

 

[mmhill]

It's hard to say I the code looks OK and I can't replicate the error. Two things to look for - is your Excel application opening a Personal.xlsm file in the background. Go inot VBA and look at the list of open files. The user function may be in there. Secondly, create a whole new PPTX with a table or 2 and a whole new XLSX file to paste to and then a whole new XLSM file to run the code. See if you can get it to work if there is a fresh start ... just try to narrow down where the error is coming from.

And this might not be it but "C:\Users\file.pptm" is't typically a valid file path. It's typically "C:\Users\[username]\[foldername]\file.pptm"