App Activate "Microsoft Powerpoint" Run Time Error 5

[bharath0708]

Hi All,

I have a code which will copy the charts in a workbook / worksheet and automatically create a PPT presentation by pasting the charts on individual slides (Please find the code below, the macro is also called Create PPT in VBA circles). Though the macro executes as intended, I have a run time error message that pops up once the code execution is complete. Please Help!

Bharat.

Code:

Sub Button4_Click()


'Add a reference to the Microsoft PowerPoint Library by:
'1. Go to Tools in the VBA menu
'2. Click on Reference
'3. Scroll down to Microsoft PowerPoint X.0 Object Library, check the box, and press Okay

'First we declare the variables we will be using
Dim newPowerPoint As PowerPoint.Application
Dim activeSlide As PowerPoint.slide
Dim cht As Excel.ChartObject

'Look for existing instance
On Error Resume Next
Set newPowerPoint = GetObject(, "PowerPoint.Application")
On Error GoTo 0

'Let's create a new PowerPoint
If newPowerPoint Is Nothing Then
Set newPowerPoint = New PowerPoint.Application
End If
'Make a presentation in PowerPoint
If newPowerPoint.Presentations.Count = 0 Then
newPowerPoint.Presentations.Add
End If

'Show the PowerPoint
newPowerPoint.Visible = True

'Loop through each chart in the Excel worksheet and paste them into the PowerPoint
For Each cht In ActiveSheet.ChartObjects

'Add a new slide where we will paste the chart
newPowerPoint.ActivePresentation.Slides.Add newPowerPoint.ActivePresentation.Slides.Count + 1, ppLayoutTitleOnly


newPowerPoint.ActiveWindow.View.GotoSlide newPowerPoint.ActivePresentation.Slides.Count
Set activeSlide = newPowerPoint.ActivePresentation.Slides(newPowerPoint.ActivePresentation.Slides.Count)

'Copy the chart and paste it into the PowerPoint as a Metafile Picture
cht.Select
ActiveChart.ChartArea.Copy
activeSlide.Shapes.PasteSpecial(DataType:=ppPasteJPEG).Select

'Set the title of the slide the same as the title of the chart
activeSlide.Shapes(1).TextFrame.TextRange.Text = cht.Chart.ChartTitle.Text


'Adjust the positioning of the Chart on Powerpoint Slide
newPowerPoint.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True
newPowerPoint.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, True

Next

AppActivate "Microsoft PowerPoint" (Run time Error "5")
Set activeSlide = Nothing
Set newPowerPoint = Nothing

'Input box to verify password

End Sub

 

[pseidt]

AppActivate "Microsoft PowerPoint" (Run time Error "5")

End Sub

I know it is an old post, but here is a solution for others.

Try
AppActivate "PowerPoint"

Best
Pat

 

[Amit_Punia]

Thanks @pseidt for the solution. Though it is an old post and you answered it a year ago, however I faced the same issue moment ago and your answer solved my problem.

Thanks Bharath for posting this question and Thanks a lot @pseidt for the solution.