CODEWITHSUNDEEP
vbaexcelpowerpoint
user10434129
user10434129

Reputation: 47

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)

Upvotes: 4

Views: 8241

Answers (1)

Ahmed AU
Ahmed AU

Reputation: 2777

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.

Upvotes: 1

Related Questions