PPT Resuse Slides in VBA with dynamic file Name

Hi folks,

I have some Excel code that contains the filename of a PPT file that needs to be inserted into an existing PPT file through the Reuse slides function.

Right now I do not know how to pass that file name from the Excel code to PPT code.

Here is the Excel code that ultimately opens a PPT file and the start of the PPT code is currently using a Hard Coded filename to use for the Reuse slides function.

Any ideas on how to replace my line 2 of the PPT code (below the Excel code) with the dynamic filename? The text of the dynamic filename can be found in cell BB107 of the Excel file.


Excel:

Code:

---


Sub FinishCategoryReview()
   
    Dim oPPApp As Object, oPPPrsn As Object, oPPSlide As Object
    Dim oPPShape As Object
    Dim PPTemplatestrName As String
    Dim XLStrName As String
    Dim URL1 As String
    Dim URL2 As String




    XLStrName = ThisWorkbook.Sheets("Report Links").Range("BB110").Value


    '  ~~> Change this to the relevant file
    PPTemplatestrName = GetDesktopPath & "Category Review Template.pptm"
 
    '  ~~> Establish an PowerPoint application object
    On Error Resume Next
    Set oPPApp = GetObject(, "PowerPoint.Application")


    If Err.Number <> 0 Then
        Set oPPApp = CreateObject("PowerPoint.Application")
    End If
    Err.Clear
    On Error GoTo 0


    oPPApp.Visible = True


    '  ~~> Open the relevant powerpoint file
    Set oPPPrsn = oPPApp.Presentations.Open(PPTemplatestrName)
    '  ~~> Change this to the relevant slide which has the shape
    Set oPPSlide = oPPPrsn.Slides(16)
    '  ~~> Change this to the relevant shape
    Set oPPShape = oPPSlide.Shapes("ADHocItemRanking")
    '    ~~> Write to the shape
    oPPShape.TextFrame.TextRange.Text = _
    ThisWorkbook.Sheets("Report Links").Range("BB104").Value
   
    '  ~~> Change this to the relevant slide which has the shape
        Set oPPSlide = oPPPrsn.Slides(16)
    '  ~~> Change this to the relevant shape
    Set oPPShape = oPPSlide.Shapes("ADHocEfficientAssortment")
    '  ~~> Write to the shape
    oPPShape.TextFrame.TextRange.Text = _
    ThisWorkbook.Sheets("Report Links").Range("BB107").Value


    AppActivate "Category Review Links.xlsm"
   
   
   
    Application.EnableEvents = False
    oPPApp.Run "Category Review Template.pptm!Module1.Finish"
    Application.EnableEvents = True
    Application.EnableEvents = False
    oPPApp.Run "Category Review Template.pptm!Module1.URL"
    Application.EnableEvents = True
 
       
    MsgBox "Congratulations! Your new Category Review has been built. You can now begin your Category Review work in the PPT file.", vbInformation
 
    AppActivate XLStrName & ".pptx"


   
End Sub

---

PPT:

Code:

---


Sub Finish()


ActivePresentation.Slides.InsertFromFile _
    "C:\Users\mogr0002\Downloads\Category Review Grand Canyon - PACKAGED BEVERAGES.pptx", 1


Dim URL1 As String
Dim URL2 As String
Dim i As Long
   
    Dim varrPos    As Variant




    varrPos = Array(34, 34, _
                    36, 36, _
                    38, 38, 38, 38, 38, 38, 38, 38, 38, _
                    40, 40, 40, 40, 40, 40, 40, _
                    43, 43, 43, 43, 43)




    With ActivePresentation
        For i = 0 To UBound(varrPos)
            .Slides(2).MoveTo toPos:=varrPos(i)
        Next i






        PPStrName = .Slides(2).Shapes("Title 1").TextFrame.TextRange.Text
        .Slides(2).Shapes("Title 1").TextFrame.TextRange.Copy
        .Slides(1).Shapes("Title 1").TextFrame.TextRange.Paste


    With ActivePresentation.Slides(1).Shapes("Title 1")


    With .TextFrame.TextRange.Font


        .Size = 40


        .Name = "Arial"


        .Bold = True




    End With


        Application.ActivePresentation.Slides(1).Shapes("Title 1") _
        .TextFrame.TextRange.ParagraphFormat.Alignment = ppAlignCenter


    End With
   
    End With


    End Sub

---