Copy Excel Chart to PowerPoint using VBA

[KevinYC]

Hello Everyone,

I am a new vba user. I am trying to copy an Excel chart into a powerpoint slide using vba. I got an error (Invalid porcedure call or argument) at this line of code "ActiveSheet.ChartObjects(chart_name).Activate" highlited in red. The code opens the powerpoint doc successfully but stops at the line colored in red. The chart's title in excel is 'income' and that's how I reference it in the fuction. What am I doing wrong?

Any input would be greatly appreciated!!

Here is my code:

Sub makePowerPoint()
...Dim PPT As PowerPoint.Application
Set PPT = New PowerPoint.Application
PPT.Visible = True
PPT.Presentations.Open Filename:="C:\My Documents\MacroTest.ppt"
Copy_chart "Sheet1", "income", 1, 250, 200, 60, 15
End Sub



Public Function copy_chart(sheet, chart_name, slide, awidth, aheight, atop, aleft)
Sheets(sheet).Select
' Set a VBE reference to Microsoft PowerPoint Object Library
Dim PPApp As PowerPoint.Application
Dim PPPres As PowerPoint.Presentation
Dim PPSlide As PowerPoint.slide
' Reference existing instance of PowerPoint
Set PPApp = GetObject(, "Powerpoint.Application")
' Reference active presentation
Set PPPres = PPApp.ActivePresentation
PPApp.ActiveWindow.ViewType = ppViewSlide
PPApp.ActiveWindow.View.GotoSlide (slide)
' Reference active slide
Set PPSlide = PPPres.Slides(PPApp.ActiveWindow.Selection.SlideRange.SlideIndex)
ActiveSheet.ChartObjects(chart_name).Activate
ActiveChart.ChartArea.Copy
PPSlide.Select
PPSlide.Shapes.PasteSpecial ppPastePNG
PPSlide.Select
PPSlide.Shapes(PPSlide.Shapes.Count).Select
Dim sr As PowerPoint.ShapeRange
Set sr = PPApp.ActiveWindow.Selection.ShapeRange
' Resize:
sr.Width = awidth
sr.Height = aheight
If sr.Width > 700 Then
sr.Width = 700
End If
If sr.Height > 420 Then
sr.Height = 420
End If
' Realign:
sr.Align msoAlignCenters, True
sr.Align msoAlignMiddles, True
sr.Top = atop
If aleft <> 0 Then
sr.Left = aleft
End If
Set PPSlide = Nothing
Set PPPres = Nothing
Set PPApp = Nothing
End Function

 

[Tanner_2004]

The charts are "floating" on top of a worksheet. For example (to see if I answered you correctly):
I insert a pivot table on new worksheet (ws) (not on the same worsheet as the source data), I usually name the ws something intuitive, as I do for the pivot table and pivot chart - I know it doesn't matter, I just want to apprise you of all of the steps.
Then on the same ws as the PT, I insert a chart served by the PT. In some case, I do not do anything with that chart (I just leave it on its native ws), in other cases, I make a copy of the pc and paste in on to a ws that I use as a dashboard.

The funny thing is...all of the charts get copied to PP. Where there are two charts on one ws, in the case of the dashboard ws, both charts get printed on the same slide. Maybe it does that because those charts are grouped (drawing format) to make them easier to move with the dashboard slicers, etc. Maybe it has to do with the grouping?

That is what I do. When I say"Charts", i mean graphs - not a datatable or anthing like that. I mean a bar or line, etc. graph. And not an in cell chart, just your "run-of-the-mill" chart.

Thank you.

 

[Jon Peltier]

So despite the error, the charts are copied to PowerPoint?

Are the charts copied as a grouped object to PowerPoint, that is, are they still grouped in PowerPoint with the same relative positions? They shouldn't be, if the code you posted is the code that's doing the copying. Also. if that's the right code, a new slide is inserted for each chart, not for each worksheet.

 

[Tanner_2004]

Yes, the charts get copied to PP despite the erroe. I am going to re-run and make sure that I am accurately reporting what is happening. Be right with you. Thank you.

 

[Tanner_2004]

Sorry for the delay. I will explain.

First, I was was wrong. Only 5 of 9 charts were being pasted to PP. There were 4, not 2 on the dashboard ws. I ungrouped the 4 on the dashboard worksheet and ran the code. The code worked beautifully by copying all 9 charts each to their own slide. Please fogive me for misinforming you - I did see two or more charts on top of eachother on one slide at least on two separate occasion - I can't explain it.

Well, before writing you to inform you of the success, I re-ran the code again, and I got a MS PowerPoint stopped working message. I received this about 6 times even after opening and closing Excel and PP - I even checked the task manager, and closed Excel from there.

I doubt that has anything to with the code. It may have to do with working over a VPN, beacuse I get it when working with very large files when i run other macros. I learned to always back-up to a flash drive even though my work is supposed to be backed-up on my employer's serve. Anyway , after the 7 th attempt, it worked great again.

Thank you very, very much. Should I consult your site for some updated code. You mentioned a line or two that whose purpose may be unnecessary. Your code will literally save me hours! Thank you.

 

[Horus23]

Hi Jon, I have seen your website and it was really helpful. Here is my code that I'm using. The problem is the size of the Title and Image. Not sure how to get that right. Below is my code:

Private Sub CopyandPastetoPPT(myRangeName As String, myTitle As String, myScaleHeight As Single, myScaleWidth As Single)
Dim NextShape As Integer


    
    Application.GoTo Reference:=myRangeName
    Selection.CopyPicture Appearance:=xlScreen, Format:=xlPicture
    Range("B1").Select
    PP.ActivePresentation.Slides.Add PP.ActivePresentation.Slides.Count + 1, 11
    Set PPSlide = PPPres.Slides(PP.ActivePresentation.Slides.Count)
    PPSlide.Shapes.Title.TextFrame.TextRange.Text = myTitle
    NextShape = PPSlide.Shapes.Count + 1
    PPSlide.Shapes.PasteSpecial 2
    PPSlide.Shapes(NextShape).ScaleHeight myScaleHeight, 1 ' I was using 0 val earlier but still no better
    PPSlide.Shapes(NextShape).ScaleWidth myScaleWidth, 1   ' I was using 0 val earlier but still no better
    PPSlide.Shapes(NextShape).Left = PPPres.PageSetup.SlideWidth \ 2 - PPPres.Shapes(NextShape).Width \ 2
    PPSlide.Shapes(NextShape).Top = 90
    
  End Sub

 

[Horus23]

Also, getting below error post exceution:

Error No.: 438


Description: Object doesn't support this property or method.

 

[Jon Peltier]

The problem is the size of the Title and Image.

Instead of

PPSlide.Shapes(NextShape).ScaleHeight myScaleHeight, 1
PPSlide.Shapes(NextShape).ScaleWidth myScaleWidth, 1

use

PPSlide.Shapes(NextShape).Height = 350
PPSlide.Shapes(NextShape).Width = 500

so you can explicitly resize the shapes. The values are in points, and you'll need to experiment a bit.

Or even better: make the copied object the right size in Excel so it comes out right when pasted into PowerPoint, without needing any resizing.

By title, I presume you mean the slide title? To adjust its size, try this:

PPSlide.Shapes.Title.TextFrame.TextRange.Font.Size = 36

Also, getting below error post exceution

Tell us which line of code is highlighted.

 

[Horus23]

so you can explicitly resize the shapes. The values are in points, and you'll need to experiment a bit.

Or even better: make the copied object the right size in Excel so it comes out right when pasted into PowerPoint, without needing any resizing.

By title, I presume you mean the slide title? To adjust its size, try this:

PPSlide.Shapes.Title.TextFrame.TextRange.Font.Size = 36



Tell us which line of code is highlighted.

Hi Jon,

The Pivot object in the worksheet is exactly as per the size we want in the PPT but still I wanted to define it in the Macro to make sure it doesn't change while pasting in the PPT.

Thanks for the suggestion on the Title Size fix.

 

[Horus23]

Jon, here is a new problem. I'm putting the entire code right from copy to paste.

Option Explicit

Dim PP As Object
Dim PPPres As Object
Dim PPSlide As Object


Private Sub CopyandPastetoPPT(myRangeName As String, myTitle As String)
Dim NextShape As Integer


    
    Application.GoTo Reference:=myRangeName
    Selection.CopyPicture Appearance:=xlScreen, Format:=xlPicture
    Range("B1").Select
    PP.ActivePresentation.Slides.Add PP.ActivePresentation.Slides.Count + 1, 11
    Set PPSlide = PPPres.Slides(PP.ActivePresentation.Slides.Count)
    PPSlide.Shapes.Title.TextFrame.TextRange.Text = myTitle
    NextShape = PPSlide.Shapes.Count + 1
    PPSlide.Shapes.PasteSpecial 2
'    PPSlide.Shapes(NextShape).Height = 350
'    PPSlide.Shapes(NextShape).Width = 350
'    PPSlide.Shapes(NextShape).Left = PPPres.PageSetup.SlideWidth \ 2 - PPPres.Shapes(NextShape).Width \ 2
'    PPSlide.Shapes(NextShape).Top = 90
    
  End Sub


Sub ExportToPPT()
Dim ActFileName As Variant
Dim ScaleFactor As Single


    On Error GoTo ErrorHandling
    ActFileName = Application.GetOpenFilename("Microsoft PowerPoint-Files (*.pptx), *.pptx")
    ScaleFactor = Range("myScaleFactor").Value
    Set PP = CreateObject("Powerpoint.Application")
    If ActFileName = False Then
        PP.Activate
        PP.Presentations.Add
        Set PPPres = PP.ActivePresentation
    Else
        PP.Activate
        Set PPPres = PP.Presentations.Open(ActFileName)
    End If
    PP.Visible = True
    [B]CopyandPastetoPPT[/B] "myDashboard01", Range("myInputStartTitles").Offset(1, 0).Value, ScaleFactor, ScaleFactor
    Set PPSlide = Nothing
    Set PPPres = Nothing
    Set PP = Nothing
    Worksheets(1).Activate
    Exit Sub


ErrorHandling:


    Set PPSlide = Nothing
    Set PPPres = Nothing
    Set PP = Nothing
    MsgBox "Error No.: " & Err.Number & vbNewLine & vbNewLine & "Description: " & Err.Description, vbCritical, "Error"


End Sub

But now I'm getting the below error (I've highlighted the error line in BOLD):

Compile Error:

Wrong number of arguments or invalid property assignment

 

[Jon Peltier]

The Pivot object in the worksheet is exactly as per the size we want in the PPT but still I wanted to define it in the Macro to make sure it doesn't change while pasting in the PPT.

Does it change? Do you know what size you want? Select the range, then in the Immediate Window type this and press enter:

?Selection.Width, Selection.Height

and use the two values as the dimensions of the shape in PowerPoint.