如何在演示文稿中循环播放幻灯片，将新的 Excel 范围粘贴到每张幻灯片的表格中答案

【问题标题】：How to loop through slides in a presentation, pasting a new Excel range into a table in each slide如何在演示文稿中循环播放幻灯片，将新的 Excel 范围粘贴到每张幻灯片的表格中
【发布时间】：2019-05-15 09:45:57
【问题描述】：

我正在尝试使用 vba 将 Excel 中大范围内的每 20 行粘贴到 powerpoint 中，在单独的幻灯片中的单独表格中每 20 行粘贴一次。我已经为此苦苦挣扎了一段时间，因此将不胜感激。

我已经尝试循环遍历 Excel 范围，我认为这可行，但我没有设法将范围粘贴到单独的幻灯片中 - 目前它们多次粘贴到同一张幻灯片中的同一张表中。

代码 1：

循环遍历 excel 范围，但粘贴到一张幻灯片中的一个特定表格中，而不是将每 20 行粘贴到单独幻灯片中的单独表格中：

Private Sub pptpasting()
Dim r As Range
Dim powerpointapp As PowerPoint.Application
Dim mypresentation As Object

Set r = ThisWorkbook.Worksheets("...").Range("C1:D847")
Set powerpointapp = GetObject(class:="PowerPoint.Application")
Set mypresentation = powerpointapp.Presentations("....ppxt")

powerpointapp.Visible = True
powerpointapp.Activate

If powerpointapp Is Nothing Then
MsgBox "PowerPoint Presentation is not open, aborting."
Exit Sub
End If

'Handle if the PowerPoint Application is not found
If Err.Number = 429 Then
MsgBox "PowerPoint could not be found, aborting."
Exit Sub
End If
On Error GoTo 0

'Make the presentation the active presentation
mypresentation.Windows(1).Activate

'copy range in excel to paste into table on powerpoint

 Dim z As Integer
 'here define the range to paste
  For z = 1 To 150 Step 20
  Range(r(z, 1), r(z + 19, 2)).Copy

' find the table on a specific slide
    With powerpointapp.ActivePresentation.Slides(3).Shapes(2).Table
    .Cell(1, 1).Select
    'paste into the table
    powerpointapp.CommandBars.ExecuteMso ("Paste")

    End With
Next z
End Sub

代码2：

我正在尝试循环浏览演示文稿中的幻灯片，但我失败并得到错误代码：Shape (unknown member) invalid request。要选择一个形状，它的视图必须处于活动状态

Private Sub pptpasting()
Dim r As Range
Dim powerpointapp As PowerPoint.Application
Dim mypresentation As Object

Set r = ThisWorkbook.Worksheets("...").Range("C1:D847")
Set powerpointapp = GetObject(class:="PowerPoint.Application")
Set mypresentation = powerpointapp.Presentations("....ppxt")

powerpointapp.Visible = True
powerpointapp.Activate

If powerpointapp Is Nothing Then
MsgBox "PowerPoint Presentation is not open, aborting."
Exit Sub
End If

   'Handle if the PowerPoint Application is not found
    If Err.Number = 429 Then
    MsgBox "PowerPoint could not be found, aborting."
    Exit Sub
    End If
    On Error GoTo 0

'Make the presentation the active presentation
mypresentation.Windows(1).Activate

'copy range in excel to paste into table on powerpoint
 Dim i As Integer
 Dim z As Integer

 'here define the range
For z = 1 To 150 Step 20
    Range(r(z, 1), r(z + 19, 2)).Copy

    'here loop through the slidse in the presentation, pasting into each slide
    For i = 3 To powerpointapp.ActivePresentation.Slides.Count
        With powerpointapp.ActivePresentation.Slides(i).Shapes(2).Table
        'Paste the range into the table
        .Cell(1, 1).Select
        powerpointapp.CommandBars.ExecuteMso ("Paste")
        End With
     Next i
Next z

End Sub

如上所述，我希望或正在尝试将每 20 行粘贴到单独幻灯片中的单独表格中，但我尝试过的两种类型的代码都不起作用 - 1) 第一个代码通过 excel 范围粘贴循环进入同一张幻灯片中的同一张表，2）第二个代码有错误。

任何帮助将不胜感激。

【问题讨论】：

看看我维护的 PPT FAQ 网站上的这个条目：pptfaq.com/…
如果以某种方式解决问题比自己实现代码更重要，您可以在这里查看：youtube.com/watch?v=LOT3mTA6DF8&t=4s 这显示了如何使用 SlideFab 2 来做到这一点。免费的 lite 版本应该足够了为了这。如有问题，请随时与我们联系。免责声明：我是 SlideFab 2 的所有者。
啊，如果可能的话，我真的很想得到一些关于如何修改上面代码的建议，我已经查看了这些链接，但没有找到解决我的问题的答案（如果我已经错过了那里的东西！）

标签： excel vba powerpoint

【解决方案1】：

我发现为 PowerPoint 表创建标签很有帮助，将标签名称设置为 TABLENAME，将标签值设置为 Excel 表的名称。然后您可以循环查找有问题的特定标签并更新该表，然后移至下一个。

我还建议将您的 Excel 数据放入 Excel 中的表格中，然后在 vba 中引用这些数据。

【讨论】：