Export Excel 2007 Charts to Powerpoint 2007 Slides

Description: This excel macro will export all the charts from the activesheet of excel workbook to a new powerpoint presentation. If there are 16 charts, then they'll be exported to 4 slides (4 Charts per slide.).

---

Instructions:

How to use:	Copy the code. Open the excel file it will be used in. Press Alt + F11 to open the VBE. From the menu bar > Insert > Module (Standard module). Paste the code in the open white window. Press Alt + Q to close the VBE and return to excel.
Test the code:	If you dont have a chart on the sheet, make one. Press Alt + F8. Select "Export Chart" > Run.

---

Code:

Sub Export_Excel_Charts_to_PowerPoint()
' http://www.excelitems.com
' http://www.openexcel.com
' By Ashish Jain

     '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
    Dim myChart As Excel.ChartObject
    Dim cNum As Integer
    
     '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

        cNum = 11
        ActiveSheet.Activate
        For Each myChart In ActiveSheet.ChartObjects
            myChart.Select
            ActiveChart.ChartArea.Copy
            ppSlide.Shapes.PasteSpecial(DataType:=ppPasteMetafilePicture).Select

            'Adjust the Chart on Powerpoint Slide
            Select Case (cNum + 10) Mod 4
            Case 1
                ppApp.ActiveWindow.Selection.ShapeRange.Align msoAlignLefts, msoTrue
                ppApp.ActiveWindow.Selection.ShapeRange.Align msoAlignTops, msoTrue
            Case 2
                ppApp.ActiveWindow.Selection.ShapeRange.Align msoAlignRights, msoTrue
                ppApp.ActiveWindow.Selection.ShapeRange.Align msoAlignTops, msoTrue
            Case 3
                ppApp.ActiveWindow.Selection.ShapeRange.Align msoAlignLefts, msoTrue
                ppApp.ActiveWindow.Selection.ShapeRange.Align msoAlignBottoms, msoTrue
            Case 0
                ppApp.ActiveWindow.Selection.ShapeRange.Align msoAlignRights, msoTrue
                ppApp.ActiveWindow.Selection.ShapeRange.Align msoAlignBottoms, msoTrue
            End Select
            If (cNum + 10) Mod 4 = 0 Then
                Set ppSlide = ppApp.ActivePresentation.Slides.Add(ppApp.ActivePresentation.Slides.Count + 1, ppLayoutBlank)
                ppSlide.Select
            End If
            cNum = cNum + 1
        Next
    
    AppActivate ("Microsoft PowerPoint")
    Set ppSlide = Nothing
    Set ppApp = Nothing
    
End Sub

---

17 ways to OPTIMIZE VBA Code for FASTER Macros

BONUS VBA MACRO: Excel 2003 Style menu in Excel 2007 / 2010

Are you going for an interview ?
3 things to remember before Excel VBA Interview
50 Excel VBA Interview questions

or looking for a job ?
 Excel, Access, SQL, VBA, MIS, Reporting and Data Analysts Jobs

Shrink or Reduce the size of Excel Workbook without losing data

Learn: VLOOKUP        OFFSET        Custom Format       Array Formula

---