0

我想将 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
4

2 回答 2

3

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

If Shape.HasTable Then
   MsgBox "It's a table."
End If
于 2013-07-02T23:51:01.487 回答
0

这是允许检查哪个幻灯片形状是表格的完整程序。您将需要循环检查.Type property每个形状。如果一个是 Table 那里你...：

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
于 2013-07-02T19:37:36.547 回答