Sometimes the table can be too tall and you wish you could just split the table over two slides automatically. Let us explore how we can achieve it in this article. The whole process involves a fixed set of steps. I've broken them up into independant functions and subroutines.

1. Check if the table is out of the slide area and determine which is the first row that moves off the slide.

Function GetRowOverFlowIndex(oShape As Shape, oPres As Presentation) As Long

Dim Index As Long
Dim sngSldHeight As Single
Dim sngCurrHeight As Single

sngSldHeight = oPres.PageSetup.SlideHeight
'Get the top position of the shape on the slide
sngCurrHeight = oShape.Top
 

For Index = 1 To oShape.Table.Rows.Count
   'Check if the current height exceeds that of the slide height

   If sngCurrHeight + oShape.Table.Rows(Index).Height > sngSldHeight Then
     'We have found the row at which the table moves off the slide.
     GetRowOverFlowIndex = Index
     Exit Function
   Else

     'Increment the current height
     sngCurrHeight = sngCurrHeight + oShape.Table.Rows(Index).Height
   End If
Next
End Function

 

2. Copy that row onwards to a new slide

 

Sub CopyToNewTable(oSlide As Slide, oSourceShape As Shape, RowIndex As Long)
Dim oTableShape As Shape
Dim I As Long
Dim J As Long

Set oTableShape = oSlide.Shapes.AddTable(oSourceShape.Table.Rows.Count - RowIndex + 1, _
                                         oSourceShape.Table.Columns.Count, _
                                         oSourceShape.Left, _
                                         oSourceShape.Top, _
                                         oSourceShape.Width)

For I = 1 To oTableShape.Table.Rows.Count
   For J = 1 To oTableShape.Table.Columns.Count
       'Copy the text from the cell.
       oSourceShape.Table.Cell(RowIndex + I - 1, J).Shape.TextFrame.TextRange.Copy

       'Paste it into the new location.
       oTableShape.Table.Cell(I, J).Shape.TextFrame.TextRange.Paste
   Next
   oTableShape.Table.Rows(I).Height = oSourceShape.Table.Rows(RowIndex + I - 1).Height
Next
End Sub

 

3. Delete the copied rows from the source table from the main routine.

 

Let us bring it altogether into this routine.

Sub SplitTable()
Dim RowIndex As Long
Dim oShp As Shape
Dim oSld As Slide
Dim I As Long

Set oShp = ActiveWindow.Selection.ShapeRange(1)

'Check if the selected shape is a table.
If Not oShp.HasTable Then
   MsgBox "This is not a table.", vbExclamation
   Exit Sub
End If

'Get the row at which table moves off the slide
RowIndex = GetRowOverFlowIndex(oShp, ActivePresentation)

'If no rows are out of slide, just get out otherwise process it
If RowIndex > 0 Then
    'Add a new slide for the a new table
    Set oSld = ActivePresentation.Slides.Add(oShp.Parent.SlideIndex + 1, oShp.Parent.Layout)

    'Now copy the rows to the new table.
    Call CopyToNewTable(oSld, oShp, RowIndex)

    'Delete the rows from the original table
    For I = oShp.Table.Rows.Count To RowIndex Step -1
       oShp.Table.Rows(I).Delete
    Next
End If
End Sub
 

To test this code:

1. Create a table with 10 rows such some of the rows are overflow out of the slide area.

2. Select the table shape.

3. Run the SplitTable macro   

 

Conclusion:

1. Note this does not work with PPT 2007. Tables are broken in the object model in PPT 2007.

2. This examples works on the current shape selection in PowerPoint, you can easily extend it to work on all the tables in the presentation.