Export Excel Ranges As Power Point Tables

Share this

April 13, 2013

Export Excel Ranges As Power Point Tables
Some months ago I published a VBA code for exporting all Excel charts to a new Power Point presentation. Having read that post, a blog reader (Hari) asked me if is possible to transfer Excel data to Power Point. I sent him a code that I wrote on the fly, but I thought that a similar code will interest a lot of people who want to include Excel data to their presentations. So, I decided to improve the initial VBA code and here it is!

The code is consisted of two subs; the first one creates a new Power Point presentation and sets the Excel ranges that will be exported. For each range the second sub creates a new table in a new slide and fills that table with the corresponding range values. By setting the desired Excel range in the first sub you can adjust the VBA code according to your needs. In the attached workbook for example I have set a steady range for each worksheet and the first sub loops through all the worksheets of the workbook. Each worksheet contains the quarterly earnings from a hypothetical shop.

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, whick 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 TablesToPowerPoint()
   
    'Exports the range A1:C5 from each sheet to a new Power Point
    'presentation as table. Each range is copied to a new slide.
       
    'By Christos Samaras
    'https://myengineeringworld.net/////

       
    Dim ws As Worksheet
         
    'Open Power Point and create a new presentation.
    Set pptApp = New Powerpoint.Application
    Set pptPres = pptApp.Presentations.Add
   
    'Show the Power Point application.
    pptApp.Visible = True

    'Transfer the data from the range of each sheet (here A1:C5),
    'to the Power Point presentation. Note, that you can also use
    'the code with different ranges, like the example below:
    'Sheet1.Activate
    'ExcelTableToPowerPoint (ActiveSheet.Range("A1:B15"))
    'Sheet2.Activate
    'ExcelTableToPowerPoint (ActiveSheet.Range("B5:D10"))
    'In this workbook the range we want to export is the same in all
    'sheets, so a loop is used in order to make the code shorter.

    For Each ws In ActiveWorkbook.Worksheets
        ws.Activate
        ExcelTableToPowerPoint (ActiveSheet.Range("A1:C5"))
    Next ws
   
    'Return the "focus" to the frist sheet.
    ActiveWorkbook.Worksheets(1).Activate
   
    'Infrom the user that the macro finished.
    MsgBox "The ranges were successfully copied to the new presentation!", vbInformation, "Done"
   
End Sub

Private Sub ExcelTableToPowerPoint(xlRange As Range)
       
    'Copies an Excel Table to a Power Point table.
   
    'By Christos Samaras
    'https://myengineeringworld.net/////


    Dim pptTable            As Table
    Dim pptTableRows        As Long
    Dim pptTableColumns     As Long
    Dim pptTableRow         As Integer
    Dim pptTableCol         As Integer
    Dim pptMinTableWidth    As Single
   
    'Check if the range is valid.
    If Application.Intersect(xlRange, ActiveSheet.Range("A1:XFD1048576")) Is Nothing Then
        MsgBox "Sorry, the range you selected is not valid!", vbCritical, "Invalid range"
        Exit Sub
    End If
   
    'Count the slides and add a new one after the last slide.
    pptSlideCount = pptPres.Slides.Count
    Set pptSlide = pptPres.Slides.Add(pptSlideCount + 1, ppLayoutBlank)
   
    'Add the table to a new slide. You can change the left property (35) and top
    'property (70) according to your own needs. You can also set the width (100) and
    'the height (200) of the table by using the following line:
    'pptSlide.Shapes.AddTable xlRange.Rows.Count, xlRange.Columns.Count, 35, 70, 100, 200

    pptSlide.Shapes.AddTable xlRange.Rows.Count, xlRange.Columns.Count, 35, 70
    Set pptTable = pptSlide.Shapes(pptSlide.Shapes.Count).Table
          
    'Pass the range values to the table.
    For pptTableRows = 1 To xlRange.Rows.Count
        For pptTableColumns = 1 To xlRange.Columns.Count
            pptTable.Cell(pptTableRows, pptTableColumns).Shape.TextFrame.TextRange.Text _
            = xlRange.Cells(pptTableRows, pptTableColumns)
            'Center alignment is used for cell contents.
            pptTable.Cell(pptTableRows, pptTableColumns).Shape.TextFrame.TextRange.ParagraphFormat.Alignment = ppAlignCenter
        Next pptTableColumns
    Next pptTableRows
   
    'Adjust the table width in order to save some slide space.
    With pptTable
        For pptTableCol = 1 To .Columns.Count
            For pptTableRow = 1 To .Rows.Count
                With .Cell(pptTableRow, pptTableCol).Shape.TextFrame
                    If pptMinTableWidth = 0 Then pptMinTableWidth = .TextRange.BoundWidth + .MarginLeft + .MarginRight + 1
                    If pptMinTableWidth < .TextRange.BoundWidth + .MarginLeft + .MarginRight + 1 Then _
                       pptMinTableWidth = .TextRange.BoundWidth + .MarginLeft + .MarginRight + 1
                End With
            Next
            .Columns(pptTableCol).Width = pptMinTableWidth
        Next
    End With
   
End Sub
Code results

The short video below demonstrates the results of the above VBA code.

Download it from here

The sample file will only work with Excel 2010 since it already have a reference to PowerPoint 14.0 Object Library. However, If you want to open it with Excel 2007 for example, open the file, switch to VBA editor (ALT + F11) and then from menu Tools -> References add a reference to the PowerPoint 12.0 Object Library. In any case, remember to enable macros before using it.

Read also

Export All Excel Charts To Power Point 

Page last modified: January 6, 2019

Christos Samaras

Hi, I am Christos, a Mechanical Engineer by profession (Ph.D.) and a Software Developer by obsession (10+ years of experience)! I founded this site back in 2011 intending to provide solutions to various engineering and programming problems.

  • Hi Karhik,

    A) After this line:

    pptSlide.Shapes.Paste

    Add these lines:

    With pptSlide.Shapes(1)
        .LockAspectRatio = msoFalse
        .Height = pptPres.PageSetup.SlideHeight
        .Width = pptPres.PageSetup.SlideWidth
        .Top = 0
        .Left = 0
    End With 

    Note, that the picture will be resized in order to occupy the entire slide, so aesthetically might not look very good.

    B) After this line:

    Worksheets("Home").Activate

    Add this line:

    pptPres.SaveAs "C:YourName.pptx"

    I hope it helps!

    Best Regards,
    Christos

  • Thanks Christos for the help.

    Please help with the below;

    A. Presently I use below code to copy a range that includes a chart to a PPT. Could you help to get the range to occupy the entire space of the slide.

    B. How to save the PPT once the copy range process is complete.

    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, which 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 TablesToPowerPoint()

    Dim ws As Worksheet

    ‘Open Power Point and create a new presentation.

    Set pptApp = New Powerpoint.Application

    Set pptPres = pptApp.Presentations.Add

    ‘Show the Power Point application.

    pptApp.Visible = True

    ‘Transfer the data from the range of each sheet (here A1:C5),

    ‘to the Power Point presentation. Note, that you can also use

    ‘the code with different ranges, like the example below:

    ‘Sheet1.Activate

    ‘ExcelTableToPowerPoint (ActiveSheet.Range(“A1:B15”))

    ‘Sheet2.Activate

    ‘ExcelTableToPowerPoint (ActiveSheet.Range(“B5:D10”))

    ‘In this workbook the range we want to export is the same in all

    ‘sheets, so a loop is used in order to make the code shorter.

    ‘For Each ws In ActiveWorkbook.Worksheets

    Worksheets(“Reporting”).Visible = True

    Worksheets(“Reporting”).Activate

    ExcelTableToPowerPoint (ActiveSheet.Range(“A1:V32”))

    ‘Next ws

    ‘Return the “focus” to the frist sheet.

    Worksheets(“Home”).Activate

    ‘Infrom the user that the macro finished.

    MsgBox “Charts were successfully copied to a new presentation!”, vbInformation, “Done”

    End Sub

    Private Sub ExcelTableToPowerPoint(xlRange As Range)

    ‘Check if the range is valid.

    If Application.Intersect(xlRange, ActiveSheet.Range(“A1:XFD1048576”)) Is Nothing Then

    MsgBox “Sorry, the range you selected is not valid!”, vbCritical, “Invalid range”

    Exit Sub

    End If

    ‘Copy the range.

    xlRange.CopyPicture

    ‘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 range as picture.

    pptSlide.Shapes.Paste

    End Sub

  • {"email":"Email address invalid","url":"Website address invalid","required":"Required field missing"}
    Add Content Block
    >