使用 VBA 将数据从 Excel 复制到 PowerPoint 表

Question

让我向你解释我想要做什么，然后我会向你解释我卡在哪里

--> 将数据从 Excel 表复制到 PowerPoint 表（它们都有相同的标题），对于包含数据的每一行

--> 如果 PowerPoint 中的表格超过一定高度，它应该开始在新幻灯片上粘贴数据

所以，我是这样接近的：

--> 首先，将 ppt 中的一张幻灯片视为母版幻灯片，其中表格有标题，下面有一个空白行 - 我将复制这张幻灯片并在移到下一张幻灯片时粘贴它

--> 从 Excel 中各复制一行并粘贴到 PowerPoint 表格中

--> 如果 PowerPoint 中的表格超过一定高度，则粘贴新的母版幻灯片（我有副本）

--> 对于 Excel 中包含数据的每一行，此循环应继续。

我正在一点一点地接近它；到目前为止，我已经创建了用于在 .ppt 表格中插入行并在幻灯片超过表格高度限制时粘贴幻灯片的循环。但我被困在这里 - 下面给出的循环仅为主幻灯片插入行并粘贴下一张幻灯片，但不插入其他幻灯片。

Public Sub Excel_cpy_pst()

Dim oTbl As Table
Dim mShp As ShapeRange
Dim shp As Object
Dim sldCount As Slide

Set sldCount = ActivePresentation.Slides(ActivePresentation.Slides.Count)

ActivePresentation.Slides(6).Copy 'Copying and using it as a master slide

Set mShp = ActivePresentation.Slides(ActivePresentation.Slides.Count).Shapes.Range(Array("MyShape"))
Set oTbl = mShp.Table

For Each shp In ActivePresentation.Slides
    If mShp.Height <= 6.34 * 72 Then
    With oTbl
        .Rows.Add (-1) 'adding  a row at the bottom of a table
    End With
    ElseIf ActivePresentation.Slides.Count <= 8 Then 'to stop it from infinite loop, putting a constatnt
        With ActivePresentation.Slides
            ActivePresentation.Slides.Paste (ActivePresentation.Slides.Count + 1)
        End With
    End If
Next

End Sub

Answer 1

如果您从复制母版幻灯片开始，您可以将新幻灯片分配给可以引用的变量。

Dim aSLide as Powerpoint.SlideRange

Set aSlide = .Slides("Slide1").Duplicate

with aSlide
  for each shp in aslide.shapes

将此添加到您的循环中以引用原始幻灯片的新副本。

如果您的幻灯片模板 (slide1) 构造为表格，您可以将文本分配给表格中的每个单元格，然后移动到下一张幻灯片而不检查大小。随便填一下就行了。

祝你好运！