CODEWITHSUNDEEP
vbapowerpoint
chrnit
chrnit

Reputation: 21

How to check powerpoint slide items for a table

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?

Edit: Office 2007 / And I was asked to paste my 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) > AnzahlSlides Then

    MsgBox "Zu wenig Slides für Einträge" & "Anzahl Slides:" & AnzahlSlides & "Anzahl Zeilen:" & AnzahlZeilen & "Benötigte Anzahl An Folien:" & (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" & vbCrLf & "Fehlernummer: " & Err.Number & _
    vbCrLf & "Fehlerbeschreibung: " & Err.Description

End Sub

Upvotes: 0

Views: 4948

Answers (2)

Steve Rindsberg
Steve Rindsberg

Reputation: 14809

Checking Shape.Type isn't reliable any longer. Shape.Type = msoTable IF the user's inserted a table onto a slide, but if they've added a table to a content placeholder, the type will be different. This is more trustworthy:

If Shape.HasTable Then
   MsgBox "It's a table."
End If

Upvotes: 3

Kazimierz Jawor
Kazimierz Jawor

Reputation: 19077

This is complete procedure which allows to check which slide shape is table. You will need to loop to check .Type property of each Shape. If one is Table there you are...:

Sub Check_if_shape_is_table()

    Dim CurrSlide As Slide
    Set CurrSlide = ActivePresentation.Slides(1) 'just for test- change accordingly

    'your copy code here:
    Worksheets("Tabelle2").Cells(Z, 1).Copy

    Dim SHP As Shape
    For Each SHP In CurrSlide.Shapes
        If SHP.Type = msoTable Then

            'change references to your cell accordingly
            SHP.Table.Cell(AktuelleIterationenFuerZielZeilen, 1).Shape.TextFrame.TextRange.Paste
        End If
    Next

End Sub

Above code will apply value to cell in each table in your slide. Assuming there is only one table it will work ok.

Alternative solution. If there are more tables and you need to add value to the last table (!!) you could do this way:

Sub Check_if_shape_is_table_FEW_TABLES()

    Dim CurrSlide As Slide
    Set CurrSlide = ActivePresentation.Slides(1) 'just for test change accordingly

    'your copy code here:
    Worksheets("Tabelle2").Cells(Z, 1).Copy

    Dim lastTableSHP As Shape

    Dim SHP As Shape
    For Each SHP In CurrSlide.Shapes
        If SHP.Type = msoTable Then
            'this will set temp variable of lastTableSHP
            Set lastTableSHP = SHP
        End If
    Next
    'apply value to the last table in the slide
    lastTableSHP.Table.Cell(AktuelleIterationenFuerZielZeilen, 1).Shape.TextFrame.TextRange.Paste

End Sub

Upvotes: 0

Related Questions