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

如何在第二张图片之后插入第二张图片，如下面第二张屏幕截图所示？这两张图片都在一个工作表中，并且在一张幻灯片中不应该重复两次。不同的工作表中有不同的图片。如果一个工作表中只有一张图片，则可以使用该图片，然后可以轻松将其复制到演示幻灯片中。

编辑：

我现在得到的是：

我需要的是这个

...并且如果我按照某人的建议注释掉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幻灯片

1 个答案: