Power Point to Excel

Copy Power Point  Table Data into Excel.


Sub PowerPointToExcel()

'PowerPoint To Excel
Dim ppt As PowerPoint.Application
Set ppt = New PowerPoint.Application
ppt.Visible = msoTrue
Dim sh As Worksheet
ppt.Presentations.Open "D:\ppt1.pptm"

For j = 1 To ppt.ActivePresentation.Slides.Count
       
        For i = 1 To ppt.ActivePresentation.Slides(j).Shapes.Count
                ppt.ActivePresentation.Slides(i).Shapes(i).Copy
                ActiveSheet.Paste
                Range("A" & ActiveSheet.UsedRange.Rows.Count + 2).Select
        Next
Next

End Sub