Importing Text from Table on Powerpoint to Excel

Question

I'm currently working on a code using VBA that will automatically import the text located in tables in Powerpoint slides to Excel either as text or as a table.

The Slides looks like this:

*** Updated Code as per TechnoDabbler assistance

    Public Sub CopySlideShapesText()

    ' Update the PowerPoint file name
    Const cPowerPointName = "test.pptx"

    Dim vPowerPoint As PowerPoint.Application
    Dim vPresentation As PowerPoint.Presentation
    Dim vSlide As PowerPoint.Slide
    Dim vPowerpointShape As PowerPoint.Shape
    Dim vSheet As Worksheet
    Dim vRowCounter As Long

    ' Open the powerpoint presentation
    Set vPowerPoint = New PowerPoint.Application
    Set vPresentation = vPowerPoint.Presentations.Open(cPowerPointName)

    ' Write the slide info onto the active excel sheet
    Set vSheet = ActiveSheet

    ' Loop through each of the slides
    vRowCounter = 1
    For Each vSlide In vPresentation.Slides

        ' Loop through each shape on the slide
        For Each vPowerpointShape In vSlide.Shapes

            ' If shape isn't a table ... copy the text
            If Not vPowerpointShape.HasTable Then
                vPowerpointShape.Copy
                vSheet.Range("A" & vRowCounter) = vPowerpointShape.TextFrame2.TextRange.Text
                vRowCounter = vRowCounter + 1
            Else
                vPowerpointShape.Copy
                vSheet.Range("A" & vRowCounter).Select
                vSheet.PasteSpecial Format:="HTML", Link:=False, DisplayAsIcon:=False
                vRowCounter = vRowCounter + vPowerpointShape.Table.Rows.Count
            End If
        Next
    Next

    vPresentation.Close
    vPowerPoint.Quit

End Sub

UPDATE

Error showing

Answer 1

@Excelsson ... a table is a shape but needs to be treated a little differently; you can paste it in as an total entity ... or you could loop through the rows and columns within a shape (that contains a table). Here is an example of code that loops through all slides, and then all shapes on the slide, and if its a simple shape then it copies in the text, or if the shape contains a tables then it copies the total table in and proceeds to the next shape (taking into account the number of rows in the table):

Option Explicit

' ---> ADD REFERENCE TO MICROSOFT POWERPOINT OBJECT LIBRARY

Public Sub CopySlideShapesText()

    ' Update the PowerPoint file name
    Const cPowerPointName = "test.pptx"

    Dim vPowerPoint As PowerPoint.Application
    Dim vPresentation As PowerPoint.Presentation
    Dim vSlide As PowerPoint.Slide
    Dim vPowerpointShape As PowerPoint.Shape
    Dim vSheet As Worksheet
    Dim vRowCounter As Long

    ' Open the powerpoint presentation
    Set vPowerPoint = New PowerPoint.Application
    Set vPresentation = vPowerPoint.Presentations.Open(cPowerPointName)

    ' Write the slide info onto the active excel sheet
    Set vSheet = ActiveSheet

    ' Loop through each of the slides
    vRowCounter = 1
    For Each vSlide In vPresentation.Slides

        ' Loop through each shape on the slide
        For Each vPowerpointShape In vSlide.Shapes

            ' If shape isn't a table ... copy the text
            If Not vPowerpointShape.HasTable Then
                If vPowerpointShape.TextFrame2.HasText Then
                    vPowerpointShape.Copy
                    vSheet.Range("A" & vRowCounter) = vPowerpointShape.TextFrame2.TextRange.Text
                    vRowCounter = vRowCounter + 1
                End If
            Else
                vPowerpointShape.Copy
                vSheet.Range("A" & vRowCounter).Select
                vSheet.PasteSpecial Format:="HTML", Link:=False, DisplayAsIcon:=False
                vRowCounter = vRowCounter + vPowerpointShape.Table.Rows.Count
            End If
        Next
    Next

    vPresentation.Close
    vPowerPoint.Quit

End Sub

An example of what it produces:

Powerpoint Slides:

Excel Output:

If you want to loop through the rows and columns of a table (or more correctly a shape that contains a table), you could adapt code from this answer: Alert if empty cell found in power point tables and in which slide using vba

Cheers