Function AddTableAsTable(ppPres As PowerPoint.Presentation, sWorksheetName As String, iSlideNumber As Integer, lTopLocation As Long, lLeftLocation As Long, sTableStyle As String) As Integer
Dim ppSlide As PowerPoint.Slide
Dim ppShapeRange As PowerPoint.ShapeRange
Dim oRow As PowerPoint.Row
Dim tbl As Table
Dim ws As Worksheet
Dim iLastColumn As Long
Dim iLastRow As Long
Dim iColumn As Long
Dim iRow As Long
Dim iTableRow As Long
Dim iTableColumn As Long
Dim rDataRange As Range
Dim dHeight As Double
On Error GoTo TableNotFound
' Get the worksheet to copy the data from.
Set ws = ThisWorkbook.Worksheets(sWorksheetName)
ws.Activate
' Find the last row and column
iLastRow = FindLastRow(ws)
iLastColumn = FindLastColumn(ws)
' As long as we find a row, select and copy all the data.
If (iLastRow > 0) Then
' Set the range to copy from the upper left to the lower right cells
Set rDataRange = Range(ws.Cells(1, 1), ws.Cells(iLastRow, iLastColumn))
' Move to the desired slide.
ppPres.Windows(1).View.GotoSlide (iSlideNumber)
' Get the slide for the table.
Set ppSlide = ppPres.Slides(iSlideNumber)
' Create the table and add the header data
Set tbl = CreateBaseTable(ppSlide, rDataRange, lTopLocation, lLeftLocation, sTableStyle)
' The data starts on second row, since the first has the header info
iTableRow = 2
' Get the height of the header row
dHeight = tbl.Rows(1).Height
' Loop through all the rows to copy
For iRow = 2 To iLastRow
' If the table does not have enough rows and is still within the height, then add another row.
If (iTableRow > tbl.Rows.Count) And (dHeight < MAX_TABLE_SIZE) Then
tbl.Rows.Add
' If the table height is at the maximum, then create a new slide.
ElseIf (dHeight >= MAX_TABLE_SIZE) Then
' Create a new slide using the same layout.
Set ppSlide = ppPres.Slides.AddSlide(ppSlide.SlideIndex + 1, ppSlide.CustomLayout)
' Set the title of the new slide to be the same as the initial slide plus some indicating it is the next part.
ppSlide.Shapes.Title.TextFrame.TextRange.Text = ppPres.Slides(iSlideNumber).Shapes.Title.TextFrame.TextRange.Text + " (Continued)"
' Move to the desired slide.
ppPres.Windows(1).View.GotoSlide (ppSlide.SlideNumber)
' Create the new table and add the header data.
Set tbl = CreateBaseTable(ppSlide, rDataRange, lTopLocation, lLeftLocation, sTableStyle)
' Reset the index
iTableRow = 2
' Reset the height
dHeight = tbl.Rows(1).Height
' Add one row for data.
tbl.Rows.Add
End If
' Copy the columns
iTableColumn = 1
For iColumn = 1 To MAX_NBR_COLUMNS
' Copy the cell text
tbl.Cell(iTableRow, iTableColumn).Shape.TextFrame.TextRange.Text = rDataRange.Cells(iRow, iColumn).Text
' Set the font size
tbl.Cell(iTableRow, iTableColumn).Shape.TextFrame.TextRange.Font.Size = 10
' Set the font
tbl.Cell(iTableRow, iTableColumn).Shape.TextFrame.TextRange.Font.Name = "Verdana"
'tbl.Cell(iTableRow, iTableColumn).Shape.TextEffect.Alignment = msoTextEffectAlignmentCentered
'Set alignment
'tbl.Cell(iTableRow, iTableColumn).VerticalAlignment = xlCenter
'tbl.Cell(iTableRow, iTableColumn).HorizontalAlignment = xlCenter
iTableColumn = iTableColumn + 1
Next iColumn
' Add the height of the newest row.
dHeight = dHeight + tbl.Rows(iTableRow).Height
iTableRow = iTableRow + 1
Next iRow
' Return the number of slides added
AddTableAsTable = ppSlide.SlideIndex - iSlideNumber
' Clean up
Set ppSlide = Nothing
End If
Exit Function
