Как проверить позиции слайда PowerPoint для таблицы

Question

Я хочу вставить данные из excel в таблицу powerpoint. Пока мой код выполняет эту функцию, но когда он используется с реальным файлом powerpoint, в слайде есть много элементов, и я не адресую правильный. Как я могу просмотреть список элементов в слайде и выполнить мой код, как только этот элемент является таблицей?

Edit: Office 2007/А меня попросили вставить свой код:

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 

Answer 1

Это полная процедура, которая позволяет проверять, которые скользят форма стола. Вам нужно будет зациклировать, чтобы проверить .Type property каждой формы. Если такова таблица, вы ...:

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 

Вышеуказанный код будет применять значение к ячейке в каждой таблице вашего слайда. Предполагая, что есть только одна таблица, она будет работать нормально.

Альтернативное решение. Если есть несколько таблиц и вам нужно добавить значение к последней таблице (!!) вы могли бы сделать так:

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 

Answer 2

Проверка Shape.Type не надежна больше. Shape.Type = msoTable Если пользователь вставил таблицу на слайд, но если они добавили таблицу в заполнитель содержимого, тип будет другим. Это заслуживает доверия:

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