Search code examples
vbaexcelpowerpoint

Extracting text from PPT and pasting it in Excel using VBA


I need to extract data from text boxes in a PowerPoint presentation and put them in respective cells in an Excel worksheet.

I have searched but can't find a suitable work-around.

This code is to print the text from slides. I can't understand how to arrange it in Excel cells.

Dim oPApp As Object
Dim oSlide As Object
Dim oShape As Object
    
Set oPApp = GetObject(, "PowerPoint.Application")
    
For Each oSlide In oPApp.ActivePresentation.Slides
    For Each oShape In oSlide.Shapes
        
        If oShape.Type = 1 Or oShape.Type = 14 Then
            Debug.Print oShape.TextFrame.TextRange.Text
        End If
            
    Next oShape
Next oSlide
    
Set oPApp = Nothing

Example of slide (Input):
Example of PPT slide (Input)

Example of sheet (Output):
Example of excel sheet (Output)


Solution

  • Supposing you want it to be done from Excel module (it could be done from PowerPoint Module also), I just adding some codes & suggestions to your code. However it is to be mentioned while looping through Shapes in a PowerPoint Slide It generally comes in order of creation of the shape. So for maintaining proper sequence of the fields, you have to work out some way sort them according to their position (i.e. top, left property or any other criteria according to the presentation). Try

        Dim oPApp As Object
        Dim oSlide As Object
        Dim oShape As Object
    
        Dim Rw, StCol, Col, Sht As Long
        Rw = 2     'Starting Row of Target excel data
        StCol = 1   'Starting Column of Target excel data
        Sht = 3   'Target Worksheet no.
    
        Set oPApp = GetObject(, "PowerPoint.Application")
        'It will only work for already opened active presentation
        'It can also be suugested that first create a powerpoint object and then open desired preesntation fron the path
    
        For Each oSlide In oPApp.ActivePresentation.Slides
        Col = StCol
            For Each oShape In oSlide.Shapes
                If oShape.Type = 1 Or oShape.Type = 14 Then
                '    Debug.Print oShape.TextFrame.TextRange.Text
                'Next line was added for putting the data into excel sheet
                ThisWorkbook.Sheets(Sht).Cells(Rw, Col).Value = 
     oShape.TextFrame.TextRange.Text
                End If
            Col = Col + 1
            Next oShape
        Rw = Rw + 1
        Next oSlide
    
        Set oPApp = Nothing
    

    however one word of caution msoTextBox type is 17 and type 14 is msoPlaceholder.