Originally Posted by
arnelgp
you need to Open the .pptm file first, the you cal Run the macro.
Dim PPTApp As Object, PPTFile As Object
Set PPTApp = CreateObject ("PowerPoint.Application")
Here is the sub in Excel where the error message happens. I bolded the line of code where it is erroring out and again, for me the code runs fine.
Sub BuildMyCategoryReview()
Dim PPTCreatedFileName As String
Dim PPTTemplateName As String
Dim PPTApp As Object
Dim PPTPrsn As Object
Dim PPTSlide As Object
Dim PPTShape As Object
Dim URL1 As String
Dim URL2 As String
IsThisOneDriveMachine
PPTCreatedFileName = ThisWorkbook.Sheets("Category Review").Range("AQ122").Value
'Change this to the relevant file
PPTTemplateName = MyDesktopPath & "\" & "Category Review Template.pptm"
'Establish an PowerPoint application object
On Error Resume Next
Set PPTApp = GetObject(, "PowerPoint.Application")
If Err.Number <> 0 Then
Set PPTApp = CreateObject("PowerPoint.Application")
End If
Err.Clear
On Error GoTo 0
PPTApp.Visible = True
'Open the relevant powerpoint file
Set PPTPrsn = PPTApp.Presentations.Open(PPTTemplateName)
'Change this to the relevant slide which has the shape
Set PPTSlide = PPTPrsn.Slides(16)
AppActivate "Category Review Builder"
'Change this to the relevant shape
Set PPTShape = PPTSlide.Shapes("ADHocItemRanking")
'Write to the shape
PPTShape.TextFrame.TextRange.Text = ThisWorkbook.Sheets("Category Review").Range("AQ110").Value
'Change this to the relevant slide which has the shape
Set PPTSlide = PPTPrsn.Slides(16)
AppActivate "Category Review Builder"
'Change this to the relevant shape
Set PPTShape = PPTSlide.Shapes("ADHocEfficientAssortment")
'Write to the shape
PPTShape.TextFrame.TextRange.Text = ThisWorkbook.Sheets("Category Review").Range("AQ113").Value
'Change this to the relevant slide which has the shape
Set PPTSlide = PPTPrsn.Slides(21)
AppActivate "Category Review Builder"
'Change this to the relevant shape
Set PPTShape = PPTSlide.Shapes("ConsumerProfile")
'Write to the shape
PPTShape.TextFrame.TextRange.Text = ThisWorkbook.Sheets("Category Review").Range("AQ116").Value
'Change this to the relevant slide which has the shape
Set PPTSlide = PPTPrsn.Slides(21)
AppActivate "Category Review Builder"
'Change this to the relevant shape
Set PPTShape = PPTSlide.Shapes("CompetitorByChannel")
'Write to the shape
PPTShape.TextFrame.TextRange.Text = ThisWorkbook.Sheets("Category Review").Range("AQ119").Value
'Change this to the relevant slide which has the shape
Set PPTSlide = PPTPrsn.Slides(2)
AppActivate "Category Review Builder"
'Change this to the relevant shape
Set PPTShape = PPTSlide.Shapes("Category Manager")
'Write to the shape
PPTShape.TextFrame.TextRange.Text = "CATEGORY MANAGER: " & ThisWorkbook.Sheets("Category Review").Range("AQ131").Value
'Change this to the relevant slide which has the shape
Set PPTSlide = PPTPrsn.Slides(2)
AppActivate "Category Review Builder"
'Change this to the relevant shape
Set PPTShape = PPTSlide.Shapes("Category Role")
'Write to the shape
PPTShape.TextFrame.TextRange.Text = "CATEGORY ROLE: " & ThisWorkbook.Sheets("Category Review").Range("AQ134").Value
'Change this to the relevant slide which has the shape
Set PPTSlide = PPTPrsn.Slides(2)
AppActivate "Category Review Builder"
'Change this to the relevant shape
Set PPTShape = PPTSlide.Shapes("Category Class")
'Write to the shape
PPTShape.TextFrame.TextRange.Text = "CATEGORY CLASS: " & ThisWorkbook.Sheets("Category Review").Range("AQ137").Value
'Change this to the relevant slide which has the shape
Set PPTSlide = PPTPrsn.Slides(2)
AppActivate "Category Review Builder"
'Change this to the relevant shape
Set PPTShape = PPTSlide.Shapes("Category Strategy")
'Write to the shape
PPTShape.TextFrame.TextRange.Text = "CATEGORY STRATEGY: " & ThisWorkbook.Sheets("Category Review").Range("AQ140").Value
'Change this to the relevant slide which has the shape
Set PPTSlide = PPTPrsn.Slides(2)
AppActivate "Category Review Builder"
'Change this to the relevant shape
Set PPTShape = PPTSlide.Shapes("Definition")
'Write to the shape
PPTShape.TextFrame.TextRange.Text = "DEFINITION: " & ThisWorkbook.Sheets("Category Review").Range("AQ156").Value
Application.EnableEvents = False
PPTApp.Run MyDesktopPath & "\" & "Category Review Template.pptm!Module1.BuildPPT"
Application.EnableEvents = True
Application.EnableEvents = False
PPTApp.Run MyDesktopPath & "\" & "Category Review Template.pptm!Module1.AddURLs"
Application.EnableEvents = True
AppActivate "Category Review Builder"
Sheets("Category Review").Activate
PPTCreatedFileName = ThisWorkbook.Sheets("Category Review").Range("AQ123").Value
ThatWasEasy
AppActivate "Circle K Category Review"
End Sub