title: How to check powerpoint slide items for a table
body: <p>I want to insert data from excel into a powerpoint table.  So far my code does that function, but when it is used with a real powerpoint file, there are many items in a slide, and I do not address the right one. How can I go through a list of items in a slide and execute my code once that item is a table?</p>
  
  <p>Edit: Office 2007 / And I was asked to paste my code:</p>
  
  <pre><code>Sub AktualisierePowerpointVonExcel()
  
  Dim AnzahlZeilen As Long
  Dim AnzahlSlides As Long
  Dim App As Object
  Dim CurrSlide As Object
  Dim AktuelleIterationenFuerSlides As Long
  Dim AktuelleIterationenFuerZielZeilen As Long
  Dim z As Long
  Dim SHP As Shape
  
  On Error GoTo Fehler
  
  z = 1
  
  AnzahlZeilen = Range("A65536").End(xlUp).Row
  
  Set App = CreateObject("PowerPoint.Application")
  App.Visible = msoTrue
  App.Presentations.Open "c:\Users\X\Desktop\1.pptm"
  
  AnzahlSlides = App.ActivePresentation.Slides.Count
  
  If (AnzahlZeilen / 6) &gt; AnzahlSlides Then
  
      MsgBox "Zu wenig Slides für Einträge" &amp; "Anzahl Slides:" &amp; AnzahlSlides &amp; "Anzahl Zeilen:" &amp; AnzahlZeilen &amp; "Benötigte Anzahl An Folien:" &amp; (AnzahlZeilen / 6)
  
  Exit Sub
  
  Else
  
  
  
              For AktuelleIterationenFuerSlides = 1 To AnzahlSlides
  
              Set CurrSlide = App.ActivePresentation.Slides(AktuelleIterationenFuerSlides)
  
                  For AktuelleIterationenFuerZielZeilen = 1 To 6
  
                      For Each SHP In CurrSlide.Shapes
  
                          If SHP.HasTable Then
  
                          Worksheets("Tabelle2").Cells(z, 1).Copy
                          SHP.Table.Cell(AktuelleIterationenFuerZielZeilen, 1).Shape.TextFrame.TextRange.Paste
  
                          Worksheets("Tabelle2").Cells(z, 2).Copy
                          SHP.Table.Cell(AktuelleIterationenFuerZielZeilen, 1).Shape.TextFrame.TextRange.Paste
  
                          Worksheets("Tabelle2").Cells(z, 3).Copy
                          SHP.Table.Cell(AktuelleIterationenFuerZielZeilen, 1).Shape.TextFrame.TextRange.Paste
  
                          z = z + 1
  
                          On Error Resume Next
  
                          End If
  
                      Next
  
                  Next
  
              Next
  
  
  
  End If
  
  Fehler:
  MsgBox "Fehler in Sub Fehler0" &amp; vbCrLf &amp; "Fehlernummer: " &amp; Err.Number &amp; _
      vbCrLf &amp; "Fehlerbeschreibung: " &amp; Err.Description
  
  End Sub
  </code></pre>