Export All Excel Charts To Power Point

The previous week a friend of mine asked me for a favor. He told me that he spends a lot of time copying Excel charts (as pictures) to Power Point presentations. The problem was that he had some really large workbooks that contained experimental results. Each workbook had more than 20 charts, so the procedure of “copy – paste special” was really time-consuming (and boring). He wanted from each workbook to create a new presentation and in every slide to include a text box with the chart title and the chart itself as picture.

My solution to his problem was the code that you will find below. The code loops in every sheet and tries to find embedded charts. Afterwards, it loops in chart sheets. Whenever a chart is found, is copied and is inserted as a picture to a new power point slide.

VBA code

Option Explicit

'Both subs require a reference to Microsoft PowerPoint xx.x Object Library.
'where xx.x is your office version (11.0 = 2003, 12.0 = 2007 and 14.0 = 2010).

'Declaring the necessary Power Point variables (are used in both subs).
Dim pptApp As PowerPoint.Application
Dim pptPres As PowerPoint.Presentation
Dim pptSlide As PowerPoint.Slide
Dim pptSlideCount As Integer

Sub ChartsToPowerPoint()

    'Exports all the chart sheets to a new power point presentation.
    'It also adds a text box with the chart title.
    
    'By Christos Samaras
    'http://www.myengineeringworld.net
    
    Dim ws As Worksheet
    Dim intChNum As Integer
    Dim objCh As Object
    
    'Count the embedded charts.
    For Each ws In ActiveWorkbook.Worksheets
        intChNum = ws.ChartObjects.Count
    Next ws
    
    'Check if there are chart (embedded or not) in the active workbook.
    If intChNum + ActiveWorkbook.Charts.Count < 1 Then
        MsgBox "Sorry, there are no charts to export!", vbCritical, "Ops"
        Exit Sub
    End If
    
    'Open PowerPoint and create a new presentation.
    Set pptApp = New PowerPoint.Application
    Set pptPres = pptApp.Presentations.Add
    
    'Loop through all the embedded charts in all worksheets.
    For Each ws In ActiveWorkbook.Worksheets
        For Each objCh In ws.ChartObjects
            Call pptFormat(objCh.Chart)
        Next objCh
    Next ws
    
    'Loop through all the chart sheets.
    For Each objCh In ActiveWorkbook.Charts
        Call pptFormat(objCh)
    Next objCh
    
    'Show the power point.
    pptApp.Visible = True

    'Cleanup the objects.
    Set pptSlide = Nothing
    Set pptPres = Nothing
    Set pptApp = Nothing
    
    'Infrom the user that the macro finished.
    MsgBox "The charts were copied successfully to the new presentation!", vbInformation, "Done"
    
End Sub

Private Sub pptFormat(xlCh As Chart)
    
    'Formats the charts/pictures and the chart titles/textboxes.
    
    'By Christos Samaras
    'http://www.myengineeringworld.net
    
    Dim chTitle As String
    Dim j As Integer
    
    On Error Resume Next
   'Get the chart title and copy the chart area.
    chTitle = xlCh.ChartTitle.Text
    xlCh.ChartArea.Copy

    'Count the slides and add a new one after the last slide.
    pptSlideCount = pptPres.Slides.Count
    Set pptSlide = pptPres.Slides.Add(pptSlideCount + 1, ppLayoutBlank)
    
    'Paste the chart and create a new textbox.
    pptSlide.Shapes.PasteSpecial ppPasteJPG
    If chTitle <> "" Then
        pptSlide.Shapes.AddTextbox msoTextOrientationHorizontal, 12.5, 20, 694.75, 55.25
    End If
                    
    'Format the picture and the textbox.
    For j = 1 To pptSlide.Shapes.Count
        With pptSlide.Shapes(j)
            'Picture position.
            If .Type = msoPicture Then
                .Top = 87.84976
                .Left = 33.98417
                .Height = 422.7964
                .Width = 646.5262
            End If
            'Text box position and formamt.
            If .Type = msoTextBox Then
                With .TextFrame.TextRange
                    .ParagraphFormat.Alignment = ppAlignCenter
                    .Text = chTitle
                    .Font.Name = "Tahoma (Headings)"
                    .Font.Size = 28
                    .Font.Bold = msoTrue
                End With
            End If
        End With
    Next j

End Sub

How to use it

The short video below demonstrates the VBA code in use.

Download it from here

The zip file contains three files, one for each office version (2003, 2007 & 2010). Each file has already a reference to the corresponding Power Point library. Just remember to enable macros before using them.

Read also

Export Excel Ranges As Power Point Tables
Resize A Picture During A Presentation

Arrange All The Pictures Of A Presentation