Excel to Powerpoint Paste Error

Hizzle2229

New Member
Joined
Jul 29, 2013
Messages
7
I have code that I am trying to debug (written by another user) - it takes Excel Charts and pastes them as pictures to Powerpoint. Everytime I run the macro it pastes the first chart into excel but then an error pops up saying "Run-Time Error 424" Object Required. I am completely stumped at this point. I have tried doing this a different way with a completely different set of code and BOTH TIMES it seems to be the error comes up at the point of actually pasting the chart. I have bolded and underline where I believe the issue is for both (as far as I know I have all the proper object tools selected. Much appreciated for the help!!

both sets of code below

Option Explicit
Sub CopyChartsToPowerPoint()
'
'Excel Application objects declaration
Dim ws As Worksheet
Dim objChartObject As ChartObject
Dim objChart As Chart
Dim objCht As Chart
Dim lngSlideKount As Long
'
'Powerpoint Application objects declaration
' You need to add a reference (Tools | References) to the Microsoft PowerPoint nn.nn Object Library
Dim pptApp As PowerPoint.Application
Dim pptPres As PowerPoint.Presentation
Dim pptSld As PowerPoint.Slide
'
'On Error GoTo Error_Para
'
'Create a new Powerpoint session
Set pptApp = CreateObject("PowerPoint.Application")
'
pptApp.Visible = msoTrue
'Create a new presentation
Set pptPres = pptApp.Presentations.Add
Set pptPres = pptApp.ActivePresentation
'
pptApp.ActiveWindow.ViewType = ppViewSlide
'
lngSlideKount = 0
For Each ws In ActiveWorkbook.Worksheets
'Verify if there is a chart object to transfer
If ws.ChartObjects.Count > 0 Then
For Each objChartObject In ws.ChartObjects
Set objChart = objChartObject.Chart
'ppLayoutBlank = 12
Set pptSld = pptPres.Slides.Add(lngSlideKount + 1, 12)
pptApp.ActiveWindow.View.GotoSlide pptSld.SlideIndex
With objChart
'Copy chart object as picture
objChart.CopyPicture xlScreen, xlBitmap, xlScreen
'Paste copied chart picture into new slide
pptSld.Shapes.Paste.Select
pptApp.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True
pptApp.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, True
End With
lngSlideKount = lngSlideKount + 1
Next objChartObject
End If
Next ws
' Now check CHART sheets:
For Each objCht In ActiveWorkbook.Charts
'ppLayoutBlank = 12
Set pptSld = pptPres.Slides.Add(lngSlideKount + 1, 12)
pptApp.ActiveWindow.View.GotoSlide pptSld.SlideIndex
With objCht
'Copy chart object as picture
.CopyPicture xlScreen, xlBitmap, xlScreen
'Paste copied chart picture into new slide
pptSld.Shapes.Paste.Select
pptApp.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True
pptApp.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, True
End With
lngSlideKount = lngSlideKount + 1
Next objCht
'
'Activate PowerPoint application
pptApp.ActiveWindow.ViewType = ppViewNormal
pptApp.Visible = True
pptApp.Activate
If lngSlideKount > 0 Then
If lngSlideKount = 1 Then
MsgBox "1 chart was copied to PowerPoint", vbOKOnly + vbInformation, "Information"
Else
MsgBox lngSlideKount & " charts were copied to PowerPoint", vbOKOnly + vbInformation, "Information"
End If
End If
'GoTo Exit_Para
'Error_Para:
'MsgBox "Error " & Err.Number & vbCrLf & vbCrLf & _
'Err.Description & vbCrLf & vbCrLf & _
"copying charts to PowerPoint", vbOKOnly + vbCritical, "Error"
'Exit_Para:
'On Error Resume Next
'Set ws = Nothing
'Set objChart = Nothing
'Set objChartObject = Nothing
'Set pptSld = Nothing
'Set pptPres = Nothing
'Set pptApp = Nothing
End Sub


PART II: CODE


Sub CreatePowerPoint()
'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, ppLayoutText
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:=ppPasteMetafilePicture).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.Left = 15
newPowerPoint.ActiveWindow.Selection.ShapeRange.Top = 125

activeSlide.Shapes(2).Width = 200
activeSlide.Shapes(2).Left = 505

'If the chart is the "US" consumption chart, then enter the appropriate comments
If InStr(activeSlide.Shapes(1).TextFrame.TextRange.Text, "US") Then
activeSlide.Shapes(2).TextFrame.TextRange.Text = Range("J7").Value & vbNewLine
activeSlide.Shapes(2).TextFrame.TextRange.InsertAfter (Range("J8").Value & vbNewLine)
'Else if the chart is the "Renewable" consumption chart, then enter the appropriate comments
ElseIf InStr(activeSlide.Shapes(1).TextFrame.TextRange.Text, "Renewable") Then
activeSlide.Shapes(2).TextFrame.TextRange.Text = Range("J27").Value & vbNewLine
activeSlide.Shapes(2).TextFrame.TextRange.InsertAfter (Range("J28").Value & vbNewLine)
activeSlide.Shapes(2).TextFrame.TextRange.InsertAfter (Range("J29").Value & vbNewLine)
End If

'Now let's change the font size of the callouts box
activeSlide.Shapes(2).TextFrame.TextRange.Font.Size = 16
Next

AppActivate ("Microsoft PowerPoint")
Set activeSlide = Nothing
Set newPowerPoint = Nothing

End Sub
 

Excel Facts

When did Power Query debut in Excel?
Although it was an add-in in Excel 2010 & Excel 2013, Power Query became a part of Excel in 2016, in Data, Get & Transform Data.

Forum statistics

Threads
1,214,905
Messages
6,122,172
Members
449,071
Latest member
cdnMech

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top