Excel 到 PowerPoint VBA

Posted 2023-02-24

【中文标题】Excel 到 PowerPoint VBA

【英文标题】：Excel to PowerPoint VBA

【发布时间】：2019-11-08 11:37:31

【问题描述】：

我正在尝试将 Excel 中的几个单元格粘贴到 PowerPoint 中的幻灯片，使用 Excel 中的 ActiveX CheckBox 作为控件。将一张幻灯片传输到我指定的 PowerPoint 演示文稿没有问题，但是当我勾选多个框时出现问题。

所以我所做的基本上是制作一个临时模板演示文稿，当我单击另一个名为“启动”按钮的按钮时，它将被粘贴到我指定的演示文稿中。这是我的代码：

Private Sub CheckBox1_Click()

If CheckBox1.Value = True Then

Dim PPSlide As PowerPoint.Slide
Dim PPPres As PowerPoint.Presentation
Dim PP As PowerPoint.Application
Set PP = CreateObject("PowerPoint.Application")
Set PPPres = PP.Presentations.Open("(my temporary filename)")
Dim iCheckCount As Integer
iCheckCount = 0
Dim obj As OLEObject

    For Each obj In ActiveSheet.OLEObjects
        If obj.Object.Value = True Then iCheckCount = iCheckCount + 1

            Next


If iCheckCount = 1 Then

Set PPSlide = PPPres.Slides(1)


With PPSlide
.Shapes("Textfeld 2").TextFrame.TextRange.Text = ActiveSheet.Range("G3").Text
.Shapes("Textfeld 3").TextFrame.TextRange.Text = ActiveSheet.Range("B3").Text
.Shapes("Textfeld 4").TextFrame.TextRange.Text = ActiveSheet.Range("C3").Text
.Shapes("Textfeld 5").TextFrame.TextRange.Text = ActiveSheet.Range("D3").Text
.Shapes("Textfeld 6").TextFrame.TextRange.Text = ActiveSheet.Range("F3").Text
End With
PPPres.Slides(1).Copy

Else
If iCheckCount > 1 Then
    PPPres.Slides.Paste
    PPPres.Slides(2).Copy

Set PPSlide = PPPres.Slides(1)
With PPSlide
.Shapes("Textfeld 2").TextFrame.TextRange.Text = ActiveSheet.Range("G3").Text
.Shapes("Textfeld 3").TextFrame.TextRange.Text = ActiveSheet.Range("B3").Text
.Shapes("Textfeld 4").TextFrame.TextRange.Text = ActiveSheet.Range("C3").Text
.Shapes("Textfeld 5").TextFrame.TextRange.Text = ActiveSheet.Range("D3").Text
.Shapes("Textfeld 6").TextFrame.TextRange.Text = ActiveSheet.Range("F3").Text
End With

End If
End If
End If
End Sub

我知道它不能用于超过 2 个盒子（复制到指定的演示文稿）。所以我的问题是：

1) 如何一次复制多张幻灯片？我试过了

For i = 1 to PPPres.Slides.Count
PPPres.Slides.Item(i).Copy
Next i

但它不会起作用。

2) 我为我拥有的每个勾选的 ActiveX CheckBox 找到了一个 if 代码。但问题是，我怎么能提到 CheckBox_Click 的所有 Sub 并让程序去做呢？ Sub 的名称是 Box1, Box2, Box3,...,Box46。

我知道我的问题真的很混乱，而且我解释得不是很好，因为我也是 VBA 新手。如果您想了解更多关于我的代码的信息，请随时问我。

谢谢！

【参考方案1】：

你可以使用例如：

ActivePresentation.Slides.Range(Array(1, 2, 3)).Duplicate
' Or
For i = 1 to PPPres.Slides.Count
    PPPres.Slides.Item(i).Duplicate
Next i