Вставьте изображения из файла Excel в слайды Powerpoint с промежуточным текстом

Question

Итак, проблема, с которой я столкнулся, объясняется следующим образом:

Я написал макрос, в котором презентация будет создана из файла Excel с помощью команды нажатия (кнопка).Мне нужно вставить 2 изображения из этого файла Excel в слайд 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 ссылается на рабочую таблицу, где вы оставили рабочую книгу открытой перед тем, как началиMacro.Поэтому не имеет значения, сколько рабочих листов у вас в рабочей книге.Также не имеет значения, на каком количестве итераций находится ваш цикл i, каждая отдельная итерация будет пытаться выбрать изображения из того же ActiveWorkseet.

И на основании удвоенных изображений на ваших скриншотах, я думаю, выРабочая тетрадь с двумя рабочими листами оставалась открытой в Рабочей тетради, содержащей два изображения, поэтому цикл i повторялся дважды, поэтому он давал вам два набора картинок.

Если вы оставили открытую рабочую книгу, отображаядругой рабочий лист (без картинок), тогда вы бы вообще не получили картинок.

Все это верно только при удалении Exit For.