VBA Powerpoint - код для добавления фотографий (из длинного списка URL-адресов) в презентацию PowerPoint без использования Excel

Question

Извиняюсь за небрежный код. Я довольно новичок в программировании на VBA. Я написал сценарий, который берет список фотографий (хранит фотографии в магазинах по всей стране) и добавляет их в презентацию Powerpoint. Для каждого магазина / оценки будет размещено до 8 фотографий в пределах доступного пространства на новом слайде PowerPoint. Сначала он определяет количество фотографий для каждого магазина / оценки, затем импортирует до 8 изображений в Excel, копирует их и вставляет в Powerpoint.

Однако я обычно имею дело со списком из 5000 изображений. Пока он работает, я не могу использовать свое приложение Excel, но оно все равно может занять очень много времени.

Мне интересно, есть ли способ вообще обойти Excel, чтобы я мог использовать Excel во время его работы. Если есть способ как-то импортировать список в Powerpoint, кажется, что он также будет работать намного быстрее / более эффективно.

Sub PhotosToPP()
' Initialize

    presPath = "C:\ppTemplate\PhotoTemplate.pptx"
    On Error Resume Next

    Set wb = ActiveWorkbook
    Set dataWS = wb.Worksheets("Data")
    Set countWS = wb.Worksheets("Counts")
    Set tempWS = wb.Worksheets("temp")
    Set menuWS = wb.Worksheets("Menu")

' Open Powerpoint Template

    Set ppApp = CreateObject("Powerpoint.Application")
    ppApp.Visible = msoTrue
    Set ppPres = ppApp.Presentations.Open(presPath)

    Set templateSlide = ppPres.Slides.Item(1)

    dataWS.Activate
        Cells(2, 2).Select

    countWS.Activate
        Cells(2, 1).Select
        lRow = Cells(Rows.Count, 1).End(xlUp).Row
        Range(Cells(2, 1), Cells(lRow, 1)).Select

        Set strRange = Selection
        Cells(2, 1).Select

'  start NewSlide

            For Each cel In strRange
                cel.Select
                    strNbr = cel.Value
                    strCity = cel.Offset(0, 1).Value
                    strState = cel.Offset(0, 2).Value
                    strAssess = cel.Offset(0, 3).Value
                    picCnt = cel.Offset(0, 4).Value
                    StoreRngCnt = ActiveCell.Rows.Row

                ppApp.Activate
                    SlideCount = ppPres.Slides.Count
                    pptLayout = ppPres.Slides(1).CustomLayout
                    Set templateSlide = ppPres.Slides.Item(1)
                        templateSlide.Copy
                        ppPres.Slides.Paste (SlideCount + 1)
                        SlideCount = ppPres.Slides.Count

                        Set workingSlide = ppPres.Slides(SlideCount)
                            workingSlide.Select
                                With workingSlide
                                    .Shapes.Title.TextFrame.TextRange = "Store #" & strNbr & " - " & strCity & ", " & strState & "  --  " & strAssess
                                End With
'  Determine Pic Count & Cap 8 Maximum pics per slide

                dataWS.Activate
                    Select Case picCnt
                        Case 0
                            NbrPics = 0
                        Case 1
                            NbrPics = 1
                        Case 2
                            NbrPics = 2
                        Case 3
                            NbrPics = 3
                        Case 4
                            NbrPics = 4
                        Case 5
                            NbrPics = 5
                        Case 6
                            NbrPics = 6
                        Case 7
                            NbrPics = 7
                        Case 8
                            NbrPics = 8
                        Case Is > 8
                            NbrPics = 8
                    End Select

                Set OriginalCell = ActiveCell
                    Range(ActiveCell.Offset(0, 5), ActiveCell.Offset(NbrPics - 1, 5)).Select

                Set PicLinkRng = Selection
                    OriginalCell.Select

 'Determine Picture size by # of photos going onto a slide

                        Select Case NbrPics
                            Case 1
                                picX = 225
                                picY = 225
                            Case 2
                                picX = 200
                                picY = 200
                            Case 3
                                picX = 175
                                picY = 175
                            Case 4
                                picX = 120
                                picY = 120
                            Case Is > 4
                                picX = 120
                                picY = 120
                        End Select


'''  Import Images into Excel application

                        For Each cel2 In PicLinkRng
                            tempWS.Activate
                            ActiveCell = cel2.Value
                            Call TestPic
                            ActiveCell.Offset(1, 0).Select
                        Next cel2

''' Determine Image Position on PPT slide


                        z = 0
                        For Each tempPic In Worksheets("Temp").Shapes
                            z = z + 1
                            tempPic.Copy
                                ppApp.Activate
                                    Set workingSlide = ppPres.Slides(ppPres.Slides.Count)
                                        workingSlide.Select
                                        Set myShape = workingSlide.Shapes.PasteSpecial(ppPastePNG)(1)

                                If NbrPics = 1 Then
                                    Select Case z
                                        Case 1
                                            picTop = 110
                                            picLeft = 250
                                    End Select

                                ElseIf NbrPics = 2 Then
                                    Select Case z
                                        Case 1
                                            picTop = 90
                                            picLeft = 100
                                        Case 2
                                            picTop = 90
                                            picLeft = 350
                                    End Select

                                ElseIf NbrPics = 3 Then
                                    Select Case z
                                        Case 1
                                            picTop = 120
                                            picLeft = 30
                                        Case 2
                                            picTop = 120
                                            picLeft = 215
                                        Case 3
                                            picTop = 120
                                            picLeft = 400
                                    End Select

                                ElseIf NbrPics = 4 Then
                                    Select Case z
                                        Case 1
                                            picTop = 150
                                            picLeft = 50
                                        Case 2
                                            picTop = 150
                                            picLeft = 175
                                        Case 3
                                            picTop = 150
                                            picLeft = 300
                                        Case 4
                                            picTop = 150
                                            picLeft = 425
                                    End Select

                                ElseIf NbrPics = 5 Then
                                    Select Case z
                                        Case 1
                                            picTop = 80
                                            picLeft = 50
                                        Case 2
                                            picTop = 80
                                            picLeft = 175
                                        Case 3
                                            picTop = 80
                                            picLeft = 300
                                        Case 4
                                            picTop = 80
                                            picLeft = 425
                                        Case 5
                                            picTop = 205
                                            picLeft = 50
                                    End Select

                                ElseIf NbrPics = 6 Then
                                    Select Case z
                                        Case 1
                                            picTop = 80
                                            picLeft = 50
                                        Case 2
                                            picTop = 80
                                            picLeft = 175
                                        Case 3
                                            picTop = 80
                                            picLeft = 300
                                        Case 4
                                            picTop = 80
                                            picLeft = 425
                                        Case 5
                                            picTop = 205
                                            picLeft = 50
                                        Case 6
                                            picTop = 205
                                            picLeft = 175
                                    End Select

                                ElseIf NbrPics = 7 Then
                                    Select Case z
                                        Case 1
                                          picTop = 80
                                            picLeft = 50
                                        Case 2
                                            picTop = 80
                                            picLeft = 175
                                        Case 3
                                            picTop = 80
                                            picLeft = 300
                                        Case 4
                                            picTop = 80
                                            picLeft = 425
                                        Case 5
                                            picTop = 205
                                            picLeft = 50
                                        Case 6
                                            picTop = 205
                                            picLeft = 175
                                        Case 7
                                            picTop = 205
                                            picLeft = 300
                                    End Select

                                ElseIf NbrPics = 8 Then
                                    Select Case z
                                        Case 1
                                            picTop = 80
                                            picLeft = 50
                                        Case 2
                                            picTop = 80
                                            picLeft = 175
                                        Case 3
                                            picTop = 80
                                            picLeft = 300
                                        Case 4
                                            picTop = 80
                                            picLeft = 425
                                        Case 5
                                            picTop = 205
                                            picLeft = 50
                                        Case 6
                                            picTop = 205
                                            picLeft = 175
                                        Case 7
                                            picTop = 205
                                            picLeft = 300
                                        Case 8
                                            picTop = 205
                                            picLeft = 425

                                    End Select

                                End If


                                    With myShape
                                        .Top = picTop
                                        .Left = picLeft
                                    End With


                        Next tempPic


'''   Delete temp pics in Excel Application
                        z = 0
                        wb.Activate
                            tempWS.Activate
                                tempWS.Shapes.SelectAll
                                Selection.Delete

                                Range("A:A").ClearContents
                                Range("A1").Select
'''  Go on to next store/assessment
                        dataWS.Activate
                            OriginalCell.Offset(picCnt, 0).Select

                            countWS.Activate
            Next cel


            menuWS.Activate

End Sub