Exporting table data from Powerpoint to Excel using VBA - Getting Error 438: Object doesn't support this property...

[ickelly]

Hello,

I have PowerPoint 2007 slides that contain tables, and I'm working on a macro that will transfer that data to Excel 2007. I don't want to just do a straight copy/paste, because I need to be able to manipulate the data as it is imported. The tables are all 5 columns wide, but vary in height. I get new tables in on a weekly basis, so would like to have code that can automate the process of tranferring this data from PowerPoint to Excel. So far, below is what I have come up with, but I'm getting a "Run-time error '438': Object doesn't support this property or method". I have Excel open, and I have selected the Excel object library in the VBE references. Any help/insight/direction/suggestions would be greatly appreciated. I feel like I'm coming to the end of my (admittedly very limited) coding capabilities.

Thanks,

Ian

Sub DataTransfer()
Dim tb As Table
Dim shp As Shape, tg$, i%
Dim kid As String
Dim start As String
Dim target As String
Dim actual As String
Dim status As String
Dim statForm As String
Dim rowNum As Integer
Dim colNum As Integer
Dim colCount As Integer
Dim rowCount As Integer
Dim exApp As Excel.Application

For i = 1 To ActivePresentation.Slides.Count
    tg = ""
    For Each shp In ActivePresentation.Slides(i).Shapes
        If shp.HasTable Then
            tg = shp.Name       'finds first table
            Exit For
        End If
    Next
    Select Case tg
        Case Is = ""
            MsgBox "Slide " & i & " has no tables", vbCritical
        Case Else
          Set tb = ActivePresentation.Slides(i).Shapes(tg).Table
          
          
          colNum = 1
          
          With tb
          
          colCount = .Columns.Count
          rowCount = .Rows.Count
          
                              
          
          For rowNum = 1 To .Rows.Count
                
                    kid = (.Cell(rowNum, colNum).Shape.TextFrame.TextRange)
                    colNum = colNum + 1
                                                             
                        start = (.Cell(rowNum, colNum).Shape.TextFrame.TextRange)
                        colNum = colNum + 1
                            
                            target = (.Cell(rowNum, colNum).Shape.TextFrame.TextRange)
                            colNum = colNum + 1
                                
                                 actual = (.Cell(rowNum, colNum).Shape.TextFrame.TextRange)
                                 colNum = colNum + 1
                                         
                                         status = (.Cell(rowNum, colNum).Shape.TextFrame.TextRange)
                                         statForm = (.Cell(rowNum, colNum).Shape.TextFrame.TextRange)
                                         colNum = 1
                
                   
                    
                   Set exApp = GetObject(, "Excel.Application")
                    With exApp.Selection
                        .ActiveCell.Value = kid
                        .ActiveCell.Offset(0, 1).Select
                        .ActiveCell.Value = start
                        .ActiveCell.Offset(0, 1).Select
                        .ActiveCell.Value = target
                        .ActiveCell.Offset(0, 1).Select
                        .ActiveCell.Value = actual
                        .ActiveCell.Offset(0, 1).Select
                            With Selection
                                .Value = status
                                .Interior.Color = statForm
                            End With
                    .ActiveCell.Offset(1, -4).Select
                   End With
                    
                    
                    
                    
            Next rowNum
           
        End With
        
        
    End Select
    
Next
End Sub

 

[jsotola]

first thing i would like to say is

"Thank you for formatting the code and posting it correctly, it is so much easier to read"

could you please single-step through the code ( click anywhere in the code and press F8)

keep repeating F8 keypress

you should see a yellow highlight bar in the code ( that is the code that will execute the next time you press F8 )

please note which line fails and post results

 

[ickelly]

Hi, thanks for taking the time to look over the code. I did a little work and reposted here (VBA Question - Exporting table data from .ppt to excel) - still can't seem to figure out how to get the data into excel - thanks again for the help - Ian

 

[jsotola]

try this code

it is pretty much your code that has been trimmed down

it expects all tables to have 5 column, last column must have color values (same as your code)

Sub DataTransfer()
    
    Dim shp As Shape, i%, j%
    
'    Dim colCount As Integer
'    Dim rowCount As Integer


    Dim rowNum As Integer
    Dim rng As Object
    
    Set rng = GetObject(, "Excel.Application").Range("a1")  ' start at top of worksheet
                        
    For i = 1 To ActivePresentation.Slides.Count
        
        For Each shp In ActivePresentation.Slides(i).Shapes
            
            If shp.HasTable Then
                
                With shp.Table
                
'                    colCount = .Columns.Count
'                    rowCount = .Rows.Count
                    
                    For rowNum = 0 To .Rows.Count - 1
                          
                        For j = 0 To 4
                            rng.Offset(rowNum, j).Value = (.Cell(rowNum + 1, j + 1).Shape.TextFrame.TextRange)
                        Next j
                        
                        rng.Offset(rowNum, 4).Interior.Color = (.Cell(rowNum + 1, 5).Shape.TextFrame.TextRange)
                        
                    Next rowNum
                    
                    Set rng = rng.Offset(rowNum + 1) ' 1 blank row between tables
                
                End With
            End If
        Next shp
    Next i


End Sub