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
'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
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.
Hi Karhik,
A) After this line:
Add these lines:
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:
Add this line:
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