Create table on slide using embedded excel file in PowerPoint VBA

Objective

To add table on slide from an embedded excel file using PowerPoint VBA.

Approach

Here we are creating a table on slide using PowerPoint VBA,which means that VBA code is written in
.pptm file.Here we have got the source excel file, which is embedded on the PowerPoint slide.We have declared the objects for embedded file, data in the embedded file and for PowerPoint presentation.

Steps

1. First we loop through each shape in slide 1.
2. Once we find that a shapes in embedded object, we find the number of rows in the excel table
3. Based upon that, we create (or add) a table on the slide 1 using “addtable” method
4.Then we add a table on slide
5.We assign the values to each cell of table in the slide
6.Change the presentation view mode to slide show mode
6.Close the workbook object , exit the code.

Code

Private Sub CommandButton1_Click()

Dim objWorkbook As Object
Dim objShape As Object
Dim objPptApp As Object
Set objWorkbook = CreateObject("Excel.application")
Set objPptApp = CreateObject("PowerPoint.Application")
Application.DisplayAlerts = ppAlertsNone

'Set the slide show in normal view
ActivePresentation.Windows(1).Activate
ActivePresentation.Slides(1).Select

'Looping through all the shapes in slide 1, and checking if it is an embeded object
For Each objShape In ActivePresentation.Slides(1).Shapes
    objShape.Select
    If objShape.Type = 7 Then
    If TypeName(objShape.OLEFormat.Object) = "Workbook" Then
    Set objWorkbook = objShape.OLEFormat.Object
    objPptApp.Visible = True
    End If
    End If
Next objShape

'Add table on slide with 5 rows and 2 columns
Set MyTableOnPptSlide = ActivePresentation.Slides(1).Shapes.AddTable(5, 2)

'Formating the table
With MyTableOnPptSlide
    .Fill.ForeColor.RGB = RGB(192, 192, 192)
    .Width = 200
    .Left = 350
    .Top = 180
End With

'Adding the values in the table
For i = 1 To 5
    MyTableOnPptSlide.Table.Cell(i, 1).Shape.TextFrame.TextRange.Text = objWorkbook.Sheets("sheet1").Range("A" & i).Value
    MyTableOnPptSlide.Table.Cell(i, 2).Shape.TextFrame.TextRange.Text = objWorkbook.Sheets("sheet1").Range("B" & i).Value
Next i

ActivePresentation.SlideShowSettings.Run
ActivePresentation.Save
Set objWorkbook = Nothing
Set objShape = Nothing
Set objPptApp = Nothing

End Sub

If we look at the images below, before executing the code, we had an embedded excel file on slide 1.

The embedded excel file in the slide had 5 rows,i.e. name of cities and countries.These 5 rows will be copied from this excel file to slide in ppt.Below shown image shows the data in excel file.

Once we click on the command button, a table will be created on the slide 1, as shown below.We can check in the image below, that excel file had 5 rows, and now a table has been created in ppt shown below, and that has 5 rows as well.