gmooney100
06-14-2021, 08:41 AM
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:
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:
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
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:
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:
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