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.
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 'http://www.myengineeringworld.net Dim ws As Worksheet 'Open Power Point and create a new presentation. Set pptApp = CreateObject("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 'http://www.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
The short video below demonstrates the results of the above VBA code.
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.
Export All Excel Charts To Power Point