Copy Excel Chart to PowerPoint using VBA

K

KevinYC

New Member
Joined
Mar 27, 2011
Messages
12
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
 
Last edited:
Sort by date Sort by votes
The sub you call has two arguments:

Code: 
Private Sub CopyandPastetoPPT(myRangeName As String, myTitle As String)

but you're trying to pass it four:

Code: 
CopyandPastetoPPT "myDashboard01", Range("myInputStartTitles").Offset(1, 0).Value, ScaleFactor, ScaleFactor

and the sub has no means to deal with the scale factors.

I'll repeat my earlier advice: use absolute sizes, not scale factors.
 
Upvote 0

Excel Facts

Easy bullets in Excel
If you have a numeric keypad, press Alt+7 on numeric keypad to type a bullet in Excel.
Jon Peltier said:
and the sub has no means to deal with the scale factors.

I'll repeat my earlier advice: use absolute sizes, not scale factors.
Click to expand...

I corrected the macro and removed the Two arguments but now nothing is being copied. Here is the modified code:

Code: 
Option Explicit

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


Private Sub CopyandPastetoPPT(myRangeName 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.FontSize = 36
    NextShape = PPSlide.Shapes.Count + 1
    PPSlide.Shapes.PasteSpecial 2
    PPSlide.Shapes(NextShape).Height = 5.56
    PPSlide.Shapes(NextShape).Width = 11.9


   
  End Sub


Sub ExportToPPT()
Dim ActFileName As Variant


    On Error GoTo ErrorHandling
    ActFileName = Application.GetOpenFilename("Microsoft PowerPoint-Files (*.pptx), *.pptx")
    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
    CopyandPastetoPPT "myDashboard01"
    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 I'm still getting the Error 438. This happens irrespective of the fact that the object is copied or not.

Can you edit the code and help me.

Thanks!
 
Upvote 0
While debugging, disable the error handling, so you can see where the error occurs. It was this line:

PPSlide.Shapes.Title.TextFrame.TextRange.FontSize = 36

which should be

PPSlide.Shapes.Placeholders(ppPlaceholderTitle).TextFrame.TextRange.Font.Size = 36

Remove this error, and the code will paste something.

Also, specifying the size in inches will give you a teeny little pasted shape, since VBA reads the size as points. Use InchesToPoints(size) to convert.

Any special reason you're using two procedures for this?

Here's your code modified to run, without aesthetic changes to the code or its output:

Code: 
Option Explicit

Dim PP As PowerPoint.Application
Dim PPPres As PowerPoint.Presentation
Dim PPSlide As PowerPoint.Slide

Private Sub CopyandPastetoPPT(myRangeName As String)
    Dim NextShape As Long
   
    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.Placeholders(ppPlaceholderTitle).TextFrame.TextRange.Font.Size = 36
    NextShape = PPSlide.Shapes.Count + 1
    PPSlide.Shapes.PasteSpecial 2
    PPSlide.Shapes(NextShape).Height = Application.InchesToPoints(5.56)
    PPSlide.Shapes(NextShape).Width = Application.InchesToPoints(11.9)
   
End Sub

Sub ExportToPPT()
    Dim ActFileName As Variant

    On Error GoTo ErrorHandling
    ActFileName = Application.GetOpenFilename("Microsoft PowerPoint-Files (*.pptx), *.pptx")
    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
    CopyandPastetoPPT "myDashboard01"
    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
 
Upvote 0
Hey Jon,

You have used:

Code: 
Dim PP As PowerPoint.ApplicationDim PPPres As PowerPoint.Presentation
Dim PPSlide As PowerPoint.Slide

There is an error:
Code: 
User defined type not found.

Any reason for using this line of command? I prefer two procedures as it's easy for me to break and test them.
 
Upvote 0
You posted this, which had an error:

Code: 
Dim PP As PowerPoint.ApplicationDim PPPres As PowerPoint.Presentation

Check what I posted:

Code: 
Dim PP As PowerPoint.Application
Dim PPPres As PowerPoint.Presentation

You have to watch what you copy and paste, and you need to look for obvious errors, like the two lines joined together.

The way your code is broken wouldn't really help too much with separate testing, and the global (well, module) variables only make it easier to get errors.
 
Upvote 0
Jon Peltier said:
You posted this, which had an error:

Code: 
Dim PP As PowerPoint.ApplicationDim PPPres As PowerPoint.Presentation

You have to watch what you copy and paste, and you need to look for obvious errors, like the two lines joined together.

The way your code is broken wouldn't really help too much with separate testing, and the global (well, module) variables only make it easier to get errors.
Click to expand...

Jon, yes I agree that I pasted the code incorrect but it was here in the post but not in the Macro. The lines were/are not joined together in the command.

I did made the changes as you had suggested and pasting here below the new version of it with everything as one but I'm still at the same error and this is on "Dim PP As PowerPoint.Application". Error "User defined type not found". I'm not that great with VBA, can you suggest an alternate command for this.

Code: 
Sub CopyandPastetoPPT()

Dim PP As PowerPoint.Application
Dim PPPres As PowerPoint.Presentation
Dim PPSlide As PowerPoint.slide

Dim NextShape As Long
Dim myRangeName As String

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.Placeholders(ppPlaceholderTitle).TextFrame.TextRange.Font.Size = 36
NextShape = PPSlide.Shapes.Count + 1
PPSlide.Shapes.PasteSpecial 2
PPSlide.Shapes(NextShape).Height = Application.InchesToPoints(5.56)
PPSlide.Shapes(NextShape).Width = Application.InchesToPoints(11.9)

Dim ActFileName As Variant


On Error GoTo ErrorHandling
ActFileName = Application.GetOpenFilename("Microsoft PowerPoint-Files (*.pptx), *.pptx")
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
CopyandPastetoPPT "myDashboard01"
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
 
Last edited:
Upvote 0
My bad. I should have mentioned this piece as well.

With the macro open in the VB Editor, go to Tools menu > References, scroll down the list until you find the item for Microsoft PowerPoint, and check the box in front of it, and click OK. This makes all of PowerPoint's object model more visible to Excel (and defines those types).
 
Upvote 0
Jon Peltier said:
My bad. I should have mentioned this piece as well.

With the macro open in the VB Editor, go to Tools menu > References, scroll down the list until you find the item for Microsoft PowerPoint, and check the box in front of it, and click OK. This makes all of PowerPoint's object model more visible to Excel (and defines those types).
Click to expand...

That option has been active but not sure why every time it is disabled. I thought about that and did checked that but I'm still getting the same error.
Code: 
Compile Error: Wrong number of arguments or invalid property assignment.
and it's on this line of code
Code: 
CopyandPastetoPPT "myDashboard01"

FYI - I've named the entire the object as "myDashboard01" so it copy all the valid Pivot Charts.
 
Last edited:
Upvote 0
Step through the code so you can see exactly where it's failing. Do this by pressing F8 to run each line in order.

But also, your sub is now

Code: 
Sub CopyandPastetoPPT()

which has no arguments, yet you're passing the range name:

Code: 
CopyandPastetoPPT "myDashboard01"

Keep the above line as is, but change the sub back to

Code: 
Sub CopyandPastetoPPT(myRangeName)

and remove this

Code: 
Dim myRangeName As String
 
Last edited:
Upvote 0

Jon i'm now on a new error
Code: 
 Error: 91 Description: Object variable or With block variable not set

Kindly check the below code, Sorry I'm back on two procedure as this is something simple for me. Also, I'm unable to Debug that is F8 isn't working for me. So that is another challenge. Sorry, for asking you this but is it possible for you to correct the below code! Thanks!

Code: 
Private Sub CopytoPPT(myRangeName As String)
    
    Dim PP As PowerPoint.Application
    Dim PPPres As PowerPoint.Presentation
    Dim PPSlide As PowerPoint.slide
    Dim NextShape As Long
       
    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.Placeholders(ppPlaceholderTitle).TextFrame.TextRange.Font.Size = 36
    NextShape = PPSlide.Shapes.Count + 1
    PPSlide.Shapes.PasteSpecial 2
    PPSlide.Shapes(NextShape).Height = Application.InchesToPoints(5.56)
    PPSlide.Shapes(NextShape).Width = Application.InchesToPoints(11.9)


End Sub


Sub ExporttoPPT()


    Dim ActFileName As Variant


    On Error GoTo ErrorHandling
    ActFileName = Application.GetOpenFilename("Microsoft PowerPoint-Files (*.pptx), *.pptx")
    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
    CopytoPPT "myDashboard01"
    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

Not sure as why these changes are not getting the desired output as earlier ones did.
 
Upvote 0
You must log in or register to reply here.

Similar threads

F
  • Question
Excel VBA to Powerpoint - paste special chart object link
Replies
3
Views
944
Domenic
D
B
  • Question
Excel to PowerPoint - Was working, not generating error....
Replies
1
Views
677
BuJay
B
B
  • Question
Export to PowerPOint using Excel VBA
Replies
0
Views
648
bronc
B
K
  • Question
VBA: PowerPoint - Copy slides from one presentation to another
Replies
1
Views
2K
krehkop
K
N
  • Question
Excel vba to hide powerpoint automation
Replies
0
Views
503
NIPUL JARIWALA
N

Forum statistics

Threads
1,214,651
Messages
6,120,744
Members
448,989
Latest member
mariah3

Share this page

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