Question

我想将excel中的数据插入到powerpoint表中。到目前为止，我的代码执行了该功能，但是当它与真正的powerpoint文件一起使用时，幻灯片中有许多项目，而我没有解决正确的问题。如何在幻灯片中查看项目列表并在该项目为表格后执行我的代码？

编辑：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

检查Shape.Type不再可靠。 Shape.Type = msoTable如果用户将表格插入幻灯片，但如果他们已将表格添加到内容占位符，则类型将不同。这更值得信赖：

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

Answer 2

这是一个完整的程序，可以检查哪个幻灯片形状是表格。您需要循环检查每个Shape的.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

如何检查表的powerpoint幻灯片项目

2 个答案: