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

 

[Jon Peltier]

Please use code tags.

You need to change the order you do things. Instead of copying each chart, making a new slide, and pasting the chart onto the slide, you need to make a new slide then copy each chart and paste it onto the slide.

I took out the steps that align the individual charts within the individual slides, because that would just put all of the charts on top of each other. They'll have to be arranged by hand.

Sub ChartsToPresentation()
  ' Set a VBE reference to Microsoft PowerPoint Object Library

  Dim PPApp As PowerPoint.Application
  Dim PPPres As PowerPoint.Presentation
  Dim PPSlide As PowerPoint.Slide
  Dim PresentationFileName As Variant
  Dim SlideCount As Long
  Dim iCht As Integer

  ' Reference existing instance of PowerPoint
  Set PPApp = GetObject(, "Powerpoint.Application")
  ' Reference active presentation
  Set PPPres = PPApp.ActivePresentation
  PPApp.ActiveWindow.ViewType = ppViewSlide

  ' Add a new slide
  SlideCount = PPPres.Slides.Count
  Set PPSlide = PPPres.Slides.Add(SlideCount + 1, ppLayoutBlank)
  PPApp.ActiveWindow.View.GotoSlide PPSlide.SlideIndex

  For iCht = 1 To ActiveSheet.ChartObjects.Count
    ' copy chart as a picture
    ActiveSheet.ChartObjects(iCht).Chart.CopyPicture _
        Appearance:=xlScreen, Size:=xlScreen, Format:=xlPicture
    ' Paste the chart
    With PPSlide
      ' paste and select the chart picture
      .Shapes.Paste.Select
    End With
  Next

  ' Clean up
  Set PPSlide = Nothing
  Set PPPres = Nothing
  Set PPApp = Nothing
End Sub

 

[KevinYC]

Jon, That worked beautifully!
Thank you so much for your help!!!

 

[sulley333]

I am trying to use this code but am getting a user-defined variable not defined error on the following line: Dim PPApp As PowerPoint.Application

Do you know if this works for Excel 2010?

I am just wondering if that is why it won't work...I have seen this same code from many sources and just am not sure why it won't work.

Any help would be greatly appreciated!

Thanks!

 

[Jon Peltier]

Have you set a reference to the Powerpoint object model? Or did you ignore the comment at the beginning of the posted code?

In the VB editor, go to the tools menu, references, scroll the list to find Microsoft Powepoint object model, and check the box in front of it.

Now the code should work. Version of Office doesn't matter.

 

[Tanner_2004]

This worked great! Thank you Jon. It does get stuck and wants to debug here. Please see bold crimson font below

For Each ws In ActiveWorkbook.Worksheets
        For i = 1 To ws.ChartObjects.Count
            Set pptSld = pptPres.Slides.AddSlide(pptPres.Slides.Count + 1, pptCL)
            pptSld.Select


            For Each pptShp In pptSld.Shapes.Placeholders
                If pptShp.PlaceholderFormat.Type = ppPlaceholderObject Then Exit For
            Next pptShp


            Set cht = ws.ChartObjects(i).Chart
' Code stope and wants to debug here. Do you now why?
[COLOR=#800000][B]            cht.ChartArea.Copy[/B][/COLOR]
            ppt.Activate
            pptShp.Select
            ppt.Windows(1).View.Paste
        Next i
    Next ws

Thank you!

 

[Jon Peltier]

Without an error message (not just an error number) it's nearly impossible to even guess.

The code you're using is very different from what I posted so long ago. For example, what's this for:

            For Each pptShp In pptSld.Shapes.Placeholders
                If pptShp.PlaceholderFormat.Type = ppPlaceholderObject Then Exit For
            Next pptShp

 

[Tanner_2004]

Thank you very much Jon. Is there updated code anywhere?

I don't know what that line of code is. It was a cut and paste which actually worked pretty welll in copying almost all of the charts.

The error message is: Method 'Copy' of object 'Chart Area' failed

If it matters, the number is '-2147418113(8000ffff)'.

Thank you for your help either way (past code) or new advice.

 

[Jon Peltier]

I don't know why that error would occur, if the previous command (Set cht = ...) did not yield an error. Is there anything "funny" about the chart being copied?

Still I don't understand what the reason is for the other few lines I indicated earlier. What is "ppCL" in this line:

Set pptSld = pptPres.Slides.AddSlide(pptPres.Slides.Count + 1, pptCL)

The code I posted in my comment of Mar 28th, 2011, 03:30 PM is tried and true. It pasted a picture of each chart, not an actual chart, but that can be modified by changing this:

    ActiveSheet.ChartObjects(iCht).Chart.CopyPicture _
        Appearance:=xlScreen, Size:=xlScreen, Format:=xlPicture

to this:

    ActiveSheet.ChartObjects(iCht).Chart.ChartArea.Copy

... although that's the same line you're having trouble with now.

 

[Tanner_2004]

Thank you Jon....I don't expect tp try to solve this. I am very appreciative of the "earlier" code.
All are pivot charts are served by the same source data and pivot cache. All but two charts are on the their own worksheets. In that case (where two charts appear on the same worksheet), those charts are copies of charts, and I have pasted them to a worksheet that I am using as a dashboard. Does the code insist that each chart be named something unique?

Thank you for your commitment to this.

 

[Jon Peltier]

Shouldn't matter if these are pivot charts. You're also not calling them by name, which could otherwise cause problems because some versions of Excel use the same name for a copied chart as the original chart. But...

All but two charts are on the their own worksheets.

Are thethe charts on their own worksheets (rows, columns, cells, etc.)? Or are they standalone chart sheets (the chart is the sheet)?