Multiple Apps

Export Excel range or Excel chart to PowerPoint (linked or unlinked)

Ease of Use

Intermediate

Version tested with

2003 

Submitted by:

brettdj

Description:

A chart or range is either appended to an existing PowerPoint application, or is added to a new instance of PowerPoint. 

Discussion:

You want to export a range or graph from Excel to PowerPoint. 

Code:

instructions for use

			

Sub Copy_Paste_to_PowerPoint() 'Requires a reference to the Microsoft PowerPoint Library via the Tools - Reference menu in the VBE Dim ppApp As PowerPoint.Application Dim ppSlide As PowerPoint.Slide 'Original code sourced from Jon Peltier http://peltiertech.com/Excel/XL_PPT.html 'This code developed at http://oldlook.experts-exchange.com:8080/Applications/MS_Office/Excel/Q_21337053.html Dim SheetName As String Dim TestRange As Range Dim TestSheet As Worksheet Dim TestChart As ChartObject Dim PasteChart As Boolean Dim PasteChartLink As Boolean Dim ChartNumber As Long Dim PasteRange As Boolean Dim RangePasteType As String Dim RangeName As String Dim AddSlidesToEnd As Boolean 'Parameters 'SheetName - name of sheet in Excel that contains the range or chart to copy 'PasteChart -If True then routine will copy and paste a chart 'PasteChartLink -If True then Routine will paste chart with Link; if = False then paste chart no link 'ChartNumber -Chart Object Number ' 'PasteRange - If True then Routine will copy and Paste a range 'RangePasteType - Paste as Picture linked or unlinked, "HTML" or "Picture". See routine below for exact values 'RangeName - Address or name of range to copy; "B3:G9" "MyRange" 'AddSlidesToEnd - If True then appednd slides to end of presentation and paste. If False then paste on current slide. 'use active sheet. This can be a direct sheet name SheetName = ActiveSheet.Name 'Setting PasteRange to True means that Chart Option will not be used PasteRange = True RangeName = "MyRange" RangePasteType = "HTML" RangeLink = True PasteChart = True PasteChartLink = True ChartNumber = 1 AddSlidesToEnd = True 'Error testing On Error Resume Next Set TestSheet = Sheets(SheetName) Set TestRange = Sheets(SheetName).Range(RangeName) Set TestChart = Sheets(SheetName).ChartObjects(ChartNumber) On Error GoTo 0 If TestSheet Is Nothing Then MsgBox "Sheet " & SheetName & " does not exist. Macro will exit", vbCritical Exit Sub End If If PasteRange And TestRange Is Nothing Then MsgBox "Range " & RangeName & " does not exist. Macro will exit", vbCritical Exit Sub End If If PasteRange = False And PasteChart And TestChart Is Nothing Then MsgBox "Chart " & ChartNumber & " does not exist. Macro will exit", vbCritical Exit Sub End If 'Look for existing instance On Error Resume Next Set ppApp = GetObject(, "PowerPoint.Application") On Error GoTo 0 'Create new instance if no instance exists If ppApp Is Nothing Then Set ppApp = New PowerPoint.Application 'Add a presentation if none exists If ppApp.Presentations.Count = 0 Then ppApp.Presentations.Add 'Make the instance visible ppApp.Visible = True 'Check that a slide exits, if it doesn't add 1 slide. Else use the last slide for the paste operation If ppApp.ActivePresentation.Slides.Count = 0 Then Set ppSlide = ppApp.ActivePresentation.Slides.Add(1, ppLayoutBlank) Else If AddSlidesToEnd Then 'Appends slides to end of presentation and makes last slide active ppApp.ActivePresentation.Slides.Add ppApp.ActivePresentation.Slides.Count + 1, ppLayoutBlank ppApp.ActiveWindow.View.GotoSlide ppApp.ActivePresentation.Slides.Count Set ppSlide = ppApp.ActivePresentation.Slides(ppApp.ActivePresentation.Slides.Count) Else 'Sets current slide to active slide Set ppSlide = ppApp.ActiveWindow.View.Slide End If End If 'Options for Copy & Paste Ranges and Charts If PasteRange = True Then 'Options for Copy & Paste Ranges If RangePasteType = "Picture" Then 'Paste Range as Picture Worksheets(SheetName).Range(RangeName).Copy ppSlide.Shapes.PasteSpecial(ppPasteDefault, link:=RangeLink).Select Else 'Paste Range as HTML Worksheets(SheetName).Range(RangeName).Copy ppSlide.Shapes.PasteSpecial(ppPasteHTML, link:=RangeLink).Select End If Else 'Options for Copy and Paste Charts Worksheets(SheetName).Activate ActiveSheet.ChartObjects(ChartNumber).Select If PasteChartLink = True Then 'Copy & Paste Chart Linked ActiveChart.ChartArea.Copy ppSlide.Shapes.PasteSpecial(link:=True).Select Else 'Copy & Paste Chart Not Linked ActiveChart.CopyPicture Appearance:=xlScreen, Size:=xlScreen, Format:=xlPicture ppSlide.Shapes.Paste.Select End If End If 'Center pasted object in the slide ppApp.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True ppApp.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, True AppActivate ("Microsoft PowerPoint") Set ppSlide = Nothing Set ppApp = Nothing End Sub

How to use:

  1. Copy the code above.
  2. Open your workbook.
  3. Hit Alt+F11 to open the Visual Basic Editor (VBE).
  4. From the menu, choose Insert-Module.
  5. Paste the code into the code window at right.
  6. While in the VBE, choose Tools - References and put a check in Microsoft PowerPoint X.X Object Library.
  7. Close the VBE, and save the file if desired.
 

Test the code:

  1. Run the macro by going to Tools-Macro-Macros and double-click Copy_Paste_to_PowerPoint
 

Sample File:

No Attachment 

Approved by Paleo


This entry has been viewed 419 times.

Please read our Legal Information and Privacy Policy
Copyright @2004 - 2020 VBA Express