Copy Named charts in Excel to specific slide in Powerpoint

allstarrunner

New Member
Joined
May 29, 2012
Messages
34
Hi, I have a workbook with multiple charts and I am trying to create a macro which will take a named chart and paste it as a picture into a specific slide in PowerPoint. The only code I have been able to find (Using Excel with Other Office Applications) is code that uses the active chart, and the active slide in PowerPoint to decide what is copied and pasted. Is someone smarter than I able to tweak the code below so I can call on a chart by name and then paste it to a specific slide? Any help is greatly appreciated!!

Code:
Sub ChartToPresentation()
' Uses Early Binding to the PowerPoint Object Model
' Set a VBE reference to Microsoft PowerPoint Object Library
Dim PPApp As PowerPoint.Application
Dim PPPres As PowerPoint.Presentation
Dim PPSlide As PowerPoint.Slide
' Make sure a chart is selected
If ActiveChart Is Nothing Then
    MsgBox "Please select a chart and try again.", vbExclamation, _
        "No Chart Selected"
Else
    ' Reference existing instance of PowerPoint
    Set PPApp = GetObject(, "Powerpoint.Application")
    ' Reference active presentation
    Set PPPres = PPApp.ActivePresentation
    PPApp.ActiveWindow.ViewType = ppViewSlide
    ' Reference active slide
    Set PPSlide = PPPres.Slides _
        (PPApp.ActiveWindow.Selection.SlideRange.SlideIndex)
    
    ' Copy chart as a picture
    ActiveChart.CopyPicture Appearance:=xlScreen, Size:=xlScreen, _
        Format:=xlPicture
    ' Paste chart
    PPSlide.Shapes.Paste.Select
    
    ' Align pasted chart
    PPApp.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True
    PPApp.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, True
    ' Clean up
    Set PPSlide = Nothing
    Set PPPres = Nothing
    Set PPApp = Nothing
End If
End Sub
 

Excel Facts

How to create a cell-sized chart?
Tiny charts, called Sparklines, were added to Excel 2010. Look for Sparklines on the Insert tab.
This copies two specific charts (referenced by sheet name and chart name) then pastes them to a specific slide (referenced by slide number).

Code:
[COLOR=darkblue]Sub[/COLOR] ChartToPresentation()
    [COLOR=green]' Uses Early Binding to the PowerPoint Object Model[/COLOR]
    [COLOR=green]' Set a VBE reference to Microsoft PowerPoint Object Library[/COLOR]
    [COLOR=darkblue]Dim[/COLOR] PPApp  [COLOR=darkblue]As[/COLOR] PowerPoint.Application
    [COLOR=darkblue]Dim[/COLOR] PPPres [COLOR=darkblue]As[/COLOR] PowerPoint.Presentation
    [COLOR=darkblue]Dim[/COLOR] PPSlide [COLOR=darkblue]As[/COLOR] PowerPoint.Slide
    
        [COLOR=green]' Reference existing instance of PowerPoint[/COLOR]
        [COLOR=darkblue]Set[/COLOR] PPApp = GetObject(, "Powerpoint.Application")
        [COLOR=green]' Reference active presentation[/COLOR]
        [COLOR=darkblue]Set[/COLOR] PPPres = PPApp.ActivePresentation
        PPApp.ActiveWindow.ViewType = ppViewSlide
        
[COLOR=green]'Copy "Chart 1" on "Sheet1" to Slide # 2[/COLOR]
        [COLOR=green]' Copy "Chart 1" on "Sheet1" as a picture[/COLOR]
        ActiveWorkbook.Sheets([COLOR=#ff0000]"Sheet1"[/COLOR]).ChartObjects([COLOR=#ff0000]"Chart 1"[/COLOR]).CopyPicture
        [COLOR=green]' Paste chart  to Slide # 2[/COLOR]
        [COLOR=darkblue]With[/COLOR] PPPres.Slides([COLOR=#ff0000]2[/COLOR]).Shapes.Paste
            [COLOR=green]' Align pasted chart[/COLOR]
            .Align msoAlignCenters, [COLOR=darkblue]True[/COLOR]
            .Align msoAlignMiddles, [COLOR=darkblue]True[/COLOR]
        [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]With[/COLOR]
        
[COLOR=green]'Copy "Chart 1" to from "Sheet3" to Slide # 4[/COLOR]
        [COLOR=green]' Copy "Chart 1" on "Sheet3" as a picture[/COLOR]
        ActiveWorkbook.Sheets([COLOR=#ff0000]"Sheet3"[/COLOR]).ChartObjects([COLOR=#ff0000]"Chart 1"[/COLOR]).CopyPicture
        [COLOR=green]' Paste chart  to Slide # 4[/COLOR]
        [COLOR=darkblue]With[/COLOR] PPPres.Slides([COLOR=#ff0000]4[/COLOR]).Shapes.Paste
            [COLOR=green]' Align pasted chart[/COLOR]
            .Align msoAlignCenters, [COLOR=darkblue]True[/COLOR]
            .Align msoAlignMiddles, [COLOR=darkblue]True[/COLOR]
        [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]With[/COLOR]
        
        [COLOR=green]' Clean up[/COLOR]
        [COLOR=darkblue]Set[/COLOR] PPSlide = [COLOR=darkblue]Nothing[/COLOR]
        [COLOR=darkblue]Set[/COLOR] PPPres = [COLOR=darkblue]Nothing[/COLOR]
        [COLOR=darkblue]Set[/COLOR] PPApp = [COLOR=darkblue]Nothing[/COLOR]
        
[COLOR=darkblue]End[/COLOR] [COLOR=darkblue]Sub[/COLOR]
 
Upvote 0

Forum statistics

Threads
1,215,509
Messages
6,125,216
Members
449,215
Latest member
texmansru47

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