将 Excel 文件中的图片插入到 Powerpoint 幻灯片中，中间插入文本

Question

所以我遇到的问题解释如下：

我已经编写了一个宏，其中将使用单击命令（按钮）从 excel 文件创建演示文稿。我需要将此 excel 文件中的 2 张图片插入到 PowerPoint 幻灯片中。两张图片之间应该用空白隔开。

这是我写的代码部分：

Sub InteractGenerator()
    Application.ScreenUpdating = False
    Dim i As Integer, wsCnt As Long

    'Boolean for tables and pictures
    Dim tableFinder As Boolean, picFinder As Boolean
    tableFinder = False
    picFinder = False

    'Count the Worksheets
    wsCnt = ThisWorkbook.Worksheets.Count
    Dim mainWb As Workbook
    Dim graphsWs As Worksheet

    For pptC = 1 To 4
        DestinationPPT = Application.ActiveWorkbook.Path & "\AL_PPT_Template.pptx"
        Set PowerPointApp = CreateObject("PowerPoint.Application")

        'Create a New Presentation
        Set myPresentation = PowerPointApp.Presentations.Open(DestinationPPT)
        Set mainWb = ThisWorkbook

        For i = 1 To wsCnt
            If tableFinder = False And picFinder = True Then
                Dim oPPtShp As Shape
                For Each oPPtShp In ActiveSheet.Shapes

                    'Needed to be added at the sheet in a range: path of picture is in A13
                    With oPPtShp
                        PowerPointApp.ActivePresentation.slides(i - 1).Shapes.AddPicture Range("A13").Value, msoFalse, msoTrue, _
                                                                                        .Left, .Top, .Width, .Height
                        DoEvents
                    End With
                    If mainWb.ActiveSheet.Index = 18 And i = 18 Then

                       'That´s for the slides which 2 pictures
                       'Here is the blank needed, the code inserts the picture from "A15" on the picture before
                       'The same problem is in the other if-condition
                        With oPPtShp
                            PowerPointApp.ActivePresentation.slides(i - 1).Shapes.AddPicture Range("A15").Value, msoFalse, msoTrue, _
                                                                                                         .Left, .Top, .Width, .Height
                            Application.Wait Now + TimeSerial(0, 0, 1)
                            DoEvents
                        End With
                    ElseIf mainWb.ActiveSheet.Index = 30 And i = 30 Then
                        With oPPtShp
                            PowerPointApp.ActivePresentation.slides(i - 1).Shapes.AddPicture Range("A15").Value, msoFalse, msoTrue, _
                                                                                                         .Left, .Top, .Width, .Height
                            Application.Wait Now + TimeSerial(0, 0, 1)
                            DoEvents
                        End With
                    End If
                    Debug.Print (i)
                    Exit For
                Next oPPtShp
            End If ' I Believe, This End If Was Missing From Your Code
        Next i
    Next pptC
    Application.ScreenUpdating = True
    MsgBox "Done!"
End Sub

如何在第一个图像之后插入第二个图像，如下面第二个屏幕截图所示？两张图片都在一张工作表中，它们不应在一张 PowerPoint 幻灯片中出现两次。不同的工作表中有不同的图片。如果一张工作表中只有一张图片，那么它可以很容易地复制到演示文稿幻灯片中。

编辑：

我现在得到的是：

我需要的是这个：

... 如果我按照某人的建议注释掉 Exit For（第 8 行，从末尾倒数），那么会发生以下情况：

Answer 1

我认为你的第一个问题源于这部分：

For i = 1 To wsCnt
        If tableFinder = False And picFinder = True Then
            Dim oPPtShp As Shape
            For Each oPPtShp In ActiveSheet.Shapes

我想你想要这一行：

For Each oPPtShp In ActiveSheet.Shapes

...宁愿像：

For Each oPPtShp In ActiveWorkbook.Worksheets(i).Shapes

完全摆脱 ActiveSheet 的其他更改：

来自：

If mainWb.ActiveSheet.Index = 18 And i = 18 Then

至：

If i = 18 Then

来自：

ElseIf mainWb.ActiveSheet.Index = 30 And i = 30 Then

至：

ElseIf i = 30 Then

事情重复了错误的次数，因为 ActiveSheet 引用了工作表，而您在启动宏之前就在其中打开了工作簿。因此，您的工作簿中有多少工作表并不重要。 i 循环的迭代次数也无关紧要，每次迭代都会尝试从同一个 ActiveWorkseet 中选取图片。

根据你的屏幕截图上的双图片，我认为你有一个工作簿，里面有 2 个工作表，在包含两张图片的工作簿中保持打开状态，所以 i 循环迭代了两次，因此它给出了你们两组图。

如果您让工作簿保持打开状态并显示另一个工作表（没有图片），那么您将根本看不到任何图片。

所有这一切只有在 Exit For 被移除后才成立。

将 Excel 文件中的图片插入到 Powerpoint 幻灯片中，中间插入文本

Insert pictures from an Excel file to Powerpoint slides with intervening text

excel

powerpoint

vba