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

我遇到的问题解释如下：

我已经编写了一个宏，其中将使用单击命令（按钮）从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幻灯片中出现两次。不同的工作表中有不同的图片。如果一张工作表中只有一张图片，那么它就可以很容易地复制到演示幻灯片中

编辑：

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

我现在得到的是：

我需要的是：

。。。如果我按照某人的建议注释掉的退出（第8行，从末尾向后计数），则会发生以下情况：

---

我认为您的第一个问题源自这一部分：

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的其他更改：

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

发件人：

致：

发件人：

致：

事情重复的次数错误，因为ActiveSheet引用了工作表，在启动宏之前，您将工作簿保持打开状态。因此，工作簿中有多少工作表并不重要。无论你的

i

循环的迭代次数是多少，每次迭代都会尝试从同一个活动工作表中选取图片

根据你截图上的两张图片，我认为你有一个工作簿，其中有两张工作表，在包含这两张图片的工作簿中保持打开状态，因此

I

循环重复了两次，因此它给了你两组图片

如果您的工作簿保持打开状态，显示另一个工作表（没有图片），那么您将完全没有图片

---

所有这一切只有在删除退出时才是正确的。

一看，我会说，这是因为您没有将

左侧

和

顶部

属性设置到幻灯片上的不同位置。做一点计算，比如测量第一张照片的高度，并在上面添加一些东西，以获得下一张照片的顶部位置。感谢您的快速响应和更正。这只是一个代码部分，整个代码本身都在工作。回答你的问题@AndrasDorko:1。pptC循环旨在为四个部门创建四个演示文稿。2.For Each oPPtShp循环有一个出口，用于避免幻灯片中的图片数量翻倍。我把它放进去，这样代码就可以从excel工作表中拍摄一次图片，并将其粘贴到powerpoint幻灯片中。3.关于tableFinder和picFinder：是的，它是关于检查我的工作簿中的表格和图片。这是一个完美的例子，说明为什么只有在绝对必要的情况下才应该使用Active工作簿和ActiveWorksheet。。。不正常。有一种特殊的情况需要使用它们。如果我只需要在一个工作簿中工作，那么使用

ActiveWorkbook

是可以的，但即使这样，我也只会在代码的初始阶段使用它将工作簿分配给对象引用变量，如

Set WB=ActiveWorkbook

（之前有

Dim WB作为工作簿

），之后我只会在代码中引用

WB

，而不是使用

ActiveWorkbook

，比如

WB.Worksheets（1）

同样，如果我在一个工作表的边界内操作，我只会在我的代码中使用

ActiveWorksheet

，甚至像上面那样，只会将它绑定到一个引用变量：

Set Sht=ActiveWorkbook.ActiveWorksheet

（当然在它前面加上

Dim Sht as Worksheet

）。然后我会在我的代码中将其称为

Sht.Range（“A1”）

------以这种方式引用工作表和工作簿既安全又简单。感谢您的编辑和更正。现在代码的效果肯定更好了。但是在我的图像中仍然有重复的内容，就像我发布的第三张图片一样。@drdave--试着在调试模式下逐步完成您的代码。这样您将看到图片翻倍…您以前使用过调试吗？@drdave---您是否愿意将Excel文件与其中的宏以及PowerPoint文档共享？是的，我通过代码进行了调试。我现在正在尝试使用两张图片查找此排除的一个通用变量。我将了解有关文件的操作。

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

ElseIf i = 30 Then