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

Question

So the problem I got is explained as followed:

I've written a macro, where a presentation will be created from excel file with a click command (button). I need to insert 2 pictures from this excel file to a powerpoint slide. Both pictures should be separated with a blank in between.

This is the code section I've written:

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

How can I insert the second Image after the first one as they are shown on the second screenshot below? Both pictures are in one worksheet, and they shouldn't be twice in one powerpoint slide. There are different pictures in different worksheets. It works if there is only one picture in one worksheet, then it gets easily copied to the presentation slides.

Edit:

What I am getting now is this:

What I need is this:

... and if I comment out Exit For (the 8th line, counting backwards from the end) as it has been suggested by someone, then this is what happens:

At a glance, I'd say it's because you're not setting the Left and Top properties to different positions on the slide. Do a bit of calculation, like taking the height of the first picture and adding something to that to get the Top position for the next one. — Cindy Meister
Thanks for the quick response and the corrections. This is just a code section, the whole code itself is working. To answer your questions @AndrasDorko: 1. The pptC loop is meant to create four presentations for four departments. 2. The For Each oPPtShp loop has an Exit for in order to avoid the double amount of pictures in my slides. I put it in so that the code takes the picture once from the excel sheet and pastes it in the powerpoint slide. 3. About the tableFinder and the picFinder: Yes it's about check my workbook for tables and pictures. — drdave
This is perfect example why ActiveWorkbook and ActiveWorksheet should only be used when it is absolutely necessary... Not as normal. There is a special situations for them to be used in. — Andras
If I only need to work within one Workbook then, it is OK to use ActiveWorkbook, but even then I would only use it at the initial stage of my code to assign that Workbook to an Object Reference Variable like Set WB = ActiveWorkbook (with Dim WB as Workbooks before it). After that I would only ever refer to WB in my code insted of using ActiveWorkbook, like WB.Worksheets(1) — Andras
Again, I would only ever use ActiveWorksheet in my code if I was operating within the boundaries of that one Worksheet, and even then like above, only by tying it to a reference variable: Set Sht = ActiveWorkbook.ActiveWorksheet (certainly preceding it with Dim Sht as Worksheet). Then I would just refer to it in my code as Sht.Range("A1"). ------- Referring to Worksheets and Workbooks this way is Safe and Simple. — Andras

Andras Andras · Accepted Answer · 2019-09-25T12:02:54

I think your FIRST problem originates from this part:

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

I think you wanted this line:

For Each oPPtShp In ActiveSheet.Shapes

... rather be like:

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

Other changes to completely get rid of ActiveSheet:

from:

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

to:

If i = 18 Then

from:

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

to:

ElseIf i = 30 Then

Things are repeated wrong number of times, because ActiveSheet references the Worksheet, where you left your Workbook open just before you started your Macro. So it doesn't matter how many Worksheets you have in your Workbook. It also doesn't matter what number of iteration your i loop is at, every single iteration will try to pick pictures from that same ActiveWorkseet.

And based on the doubled pictures on your screenshots, I think you had a Workbook with 2 Worksheets in it left open at the Workbook containing the two pictures, so the i loop iterated twice, hence it gave you two sets of pictures.

If you left your Workbook open displaying the other Worksheet (with no pictures), then you would have gotten no pictures at all.

All this is only true when Exit For is removed.

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

1 Answers