none
Insert Dynamic Images into PPT RRS feed

  • Question

  • Hello,

    Based on much of the other good discussion in this forum I was able to build out the code below to insert both text and images in a PPT presentation.  Each slide has 3 elements -- a TITLE text block (named by me through different macro), a BULLETS text block and an IMAGE block.  I am able to populate both TITLE and BULLETS (with appropriate indenting), but I cannot figure out how to get the images to populate in the IMAGE block dynamically. 

    I have a column (column H) in the source workbook that has the file name "1.png."  But every time I run the macro, I get an error saying couldn't load the file, and it shows only the path through the folder.  As you can see in the code, I am trying to combine imageFolder and imageName into single string imagePath.  But not sure if that is the best way to do it.

    Any suggestions would be greatly appreciated.  Thank you!

    Here is the existing code:

    Sub MailMergeWithExcel()
        'Don't forget to reference "Microsoft Excel 15.0 Object Library"
        Dim XL As Excel.Workbook
        Set XL = Excel.Application.Workbooks.Open("h:\macro\option 2\source v7.xlsm")
        Dim imageName As String
        Dim imageFolder As String
        Dim imagePath As String
        imageFolder = "H:\macro\option 2\Images\"
        imagePath = imageFolder & imageName

        Dim ColumnA As String
        Dim ColumnB As String
        Dim ColumnC As String
        Dim ColumnD As String
        Dim ColumnE As String
        Dim ColumnF As String
        Dim ColumnG As String
        Dim ColumnH As String
        
        Dim x As Long
        Dim i As Long
        'this is for the slides part starts in slide number 1
        Dim mySlide As Long
        mySlide = 1
        Dim tr As TextRange
        Dim s As String
        Dim imageBox As Shape
     
        'first row is the header: ColumnA, ColumnB
        'second row is where data starts
        x = 2
     
        Do While XL.Sheets(1).Cells(x, 1) <> ""
            'Get row from excel
            ColumnA = XL.Sheets(1).Cells(x, 1)
            ColumnB = XL.Sheets(1).Cells(x, 2)
            ColumnC = XL.Sheets(1).Cells(x, 3)
            ColumnD = XL.Sheets(1).Cells(x, 4)
            ColumnE = XL.Sheets(1).Cells(x, 5)
            ColumnF = XL.Sheets(1).Cells(x, 6)
            ColumnG = XL.Sheets(1).Cells(x, 7)
            ColumnH = XL.Sheets(1).Cells(x, 8)
     
            'Add row from excel into Slide
            If ActivePresentation.Slides.Count >= mySlide Then
                'select slide
                ActivePresentation.Slides(mySlide).Select
     
                'fill data in textboxes
                For i = 1 To ActiveWindow.Selection.SlideRange.Shapes.Count()
                    'uncomment the following line to know the top position of the shape
                    'MsgBox ActiveWindow.Selection.SlideRange.Shapes(i).Top
     
                    Select Case ActiveWindow.Selection.SlideRange.Shapes(i).Name
                    Case "Title"
                        'first textbox
                        ActiveWindow.Selection.SlideRange.Shapes(i).TextFrame.TextRange.Text = ColumnA
                    Case "Bullets"
                        'second textbox
                        s = "Description:" & Chr(13) & ColumnB & Chr(13) & "" & Chr(13) & "Timing:" & Chr(13) & ColumnC & " - " & ColumnD & Chr(13) & "" & Chr(13) & "Objectives:" & Chr(13) & ColumnE & Chr(13) & ColumnF & Chr(13) & ColumnG ' Chr(9) is tab but this doesn't work
                        With ActiveWindow.Selection.SlideRange.Shapes(i).TextFrame.TextRange
                            .Text = s
                            .Paragraphs(1).IndentLevel = 1
                            .Paragraphs(2).IndentLevel = 2
                            .Paragraphs(3).IndentLevel = 1
                            .Paragraphs(4).IndentLevel = 1
                            .Paragraphs(5).IndentLevel = 2
                            .Paragraphs(6).IndentLevel = 1
                            .Paragraphs(7).IndentLevel = 1
                            .Paragraphs(8).IndentLevel = 2
                            .Paragraphs(9).IndentLevel = 2
                            .Paragraphs(10).IndentLevel = 2
                        End With
                     Case "Image"
                        'image box
                        imageName = ColumnH
                        Set imageBox = ActiveWindow.Selection.SlideRange.Shapes.AddPicture(imagePath, msoFalse, msoTrue, Left:=60, Top:=35, Width:=98, Height:=48)
                    End Select
                Next i
            Else
                'I have more rows in Excel than slides in this presentation
                MsgBox "There are more rows in Excel than slides in this presentation"
                'leave
                Exit Do
            End If
            'Next row
            x = x + 1
            'next slide
            mySlide = mySlide + 1
        Loop
        'Clean up
        XL.Close
        Set XL = Nothing
    End Sub

    Thursday, July 5, 2018 4:54 PM