Paste Excel chart as pictures in PowerPoint (Paste Special)

PowerPoint object model does not include a Paste Special method to import Excel charts as pictures. However we can create one of our own using the CopyPicture method available in Excel. Thanks to Brian Reilly, PowerPoint MVP for pointing this out to me.

' --------------------------------------------------------------------------------
' Copyright ©1999-2007, Shyam Pillai, All Rights Reserved.
' --------------------------------------------------------------------------------
' You are free to use this code within your own applications, add-ins,
' documents etc but you are expressly forbidden from selling or
' otherwise distributing this source code without prior consent.
' This includes both posting free demo projects made from this
' code as well as reproducing the code in text or html format.
' --------------------------------------------------------------------------------

Sub XlChartPasteSpecial()

   Dim xlApp As Object
   Dim xlWrkBook As Object
   Dim lCurrSlide As Long

    Set xlApp = CreateObject("Excel.Application")

   ' Open the Excel workbook

    Set xlWrkBook = xlApp.Workbooks.Open("C:\BOOK1.XLS")

   ' Copy picture of the 1st chart object onto the clipboard

    xlWrkBook.Worksheets(1).ChartObjects(1).CopyPicture

   ' Get the slide number

    lCurrSlide = ActiveWindow.Selection.SlideRange.SlideNumber

   ' Paste the picture onto the PowerPoint slide.

    ActivePresentation.Slides(lCurrSlide).Shapes.Paste

   ' Close the open workbook without saving changes

    xlWrkBook.Close (False)
    xlApp.Quit

    Set xlApp = Nothing
    Set xlWrkBook = Nothing

End Sub

Export Slides within a Presentation as files

It is known the the Export method can be used to export slides as graphics. However it is little known that the Export method can also be used to export a slide as a presentation. Given below is the code to export each slide as a separate presentation. Add/Modify stuff as required. Be sure to add some error handling.

You might notice the code block A and may be interested to understand it's relevance within the export routine. When the slide is exported as a presentation, PowerPoint by default embeds the true type fonts used in that slide. This will cause an increase in file size as much as 12 MB for a single presentation if Unicode fonts are present. Hence in Block A I reopen the export file and save it again with the embed font property set to FALSE. It may be removed if you want to retain the embedded font state.

Note: If the slide has Unicode fonts, it could take a while in exporting the slide. It would be prudent to warn the user of the delay before exporting the slide.

' --------------------------------------------------------------------------------
' Copyright ©1999-2007, Shyam Pillai, All Rights Reserved.
' --------------------------------------------------------------------------------
' You are free to use this code within your own applications, add-ins,
' documents etc but you are expressly forbidden from selling or
' otherwise distributing this source code without prior consent.
' This includes both posting free demo projects made from this
' code as well as reproducing the code in text or html format.
' --------------------------------------------------------------------------------

Option Explicit

Sub ExportSlidesAsPresentations()
    Dim oPres As Presentation
    Dim oExportedPres As Presentation
    Dim oSld As Slide
    Dim sSlideOutputFolder As String
    Dim sFilename As String

    sSlideOutputFolder = "D:\Temp\"
    Set oPres = ActivePresentation
    For Each oSld In oPres.Slides
        sFilename = (sSlideOutputFolder) & "Slide" & _
                Format(oSld.SlideIndex, "000") & ".ppt"
        oSld.Export sFilename, "PPT"

'----- Block A -----
        Set oExportedPres = Presentations.Open(sFilename, _
                False, False, False)
        Call oExportedPres.SaveAs(sFilename, _
                ppSaveAsPresentation, False)
        oExportedPres.Close
        Set oExportedPres = Nothing
'----- End of Block A -----

    Next oSld
    Set oPres = Nothing
End Sub