write ppt textboxes to excel.

[bbrimberry]

hello all,

I am trying to loop through all ppt textboxes in the active pres and write the data to excel

here's the code.. currently it's throwing a class not registered error.
would appreciate any help.

thanks!




Dim ppapp As PowerPoint.Application

Dim pppres As PowerPoint.Presentation



Sub getshapedata()

'On Error GoTo line1

Set ppapp = GetObject(, "Powerpoint.application")

Set pppres = ppapp.ActivePresentation



Dim shapeslide

Dim shapename

Dim shapetext

Dim nextrow

Dim currentSlide As Slide

Dim shp As Shape







For Each currentSlide In ActivePresentation.Slides



For Each shp In currentSlide.Shapes

' Check if the shape type is msoTextBox

If shp.Type = 17 Then



shapeslide = currentSlide.SlideIndex

shapename = shp.Name

shapetext = shp.TextEffect





nextrow = Sheet1.Range("a" & Rows.Count).End(xlUp).Row + 1



Sheet1.Range("a" & nextrow) = shapeslide

Sheet1.Range("b" & nextrow) = shapename

Sheet1.Range("c" & nextrow) = shapetext







End If

Next shp

Next currentSlide





End Sub

 

[sijpie]

Hi bbrimberry,

first of all, you should be aware by now that you need to post code between cod brackets. Simple to do and you will get a better response to your questions, because it makes it much easier to read your question. Click on the little VBA icon above the post area and paste your code.

I am assuming you have added the Microsoft Powerpoint reference to your project, else you will get errors during the compile.
If not (or for other readers), go to Tools menu, References..., then go down the list until Microsoft Powerpoint Object Library and put a tick in front.

Now the VBA editor will find all the required references to PowerPoint objects

Also you are a bit sloppy with your coding, Dim'ming everything as variants, using names that are look-alike, not using some capitalisation in the names. This will cause you lots of headaches in the end.

Dim'ming something as a Shape in Excel VBA will lead to an error if it refers to a PowerPoint shape, so you need to define it as Powerpoint.Shape.

Option Explicit



Sub GetShapeData()

    Dim ppApp As PowerPoint.Application
    Dim ppPres As PowerPoint.Presentation
    Dim iSlideNum As Integer
    Dim sName As String, sText As String
    Dim lNextRow As Long
    Dim currentSlide As PowerPoint.Slide
    Dim shpS As PowerPoint.Shape
    

    Set ppApp = GetObject(, "Powerpoint.application")
    
    Set ppPres = ppApp.ActivePresentation
    
    
    lNextRow = Sheet1.Range("a" & Rows.Count).End(xlUp).Row
    If lNextRow > 1 Then lNextRow = lNextRow + 1
    
    
    For Each currentSlide In ppPres.Slides
        For Each shpS In currentSlide.Shapes
        
            ' Check if the shape type is msoTextBox  (17)
            
            If shpS.Type = msoTextBox Then
                iSlideNum = currentSlide.SlideIndex
                
                sName = shpS.Name
                
                sText = shpS.TextEffect.Text
                Sheet1.Range("a" & lNextRow) = iSlideNum
                
                Sheet1.Range("b" & lNextRow) = sName
                
                Sheet1.Range("c" & lNextRow) = sText
                lNextRow = lNextRow + 1
            End If
        Next shpS
    Next currentSlide

End Sub

 

[bbrimberry]

great stuff

thank you