Word Table in PowerPoint

A table in PowerPoint 97 was a Word Table inserted into a PowerPoint slide. Hence manipulating the contents of the shape requires knowledge of the MS Word object model. In this example, we shall insert a Word object onto the slide and create a table within the Word document. 

' --------------------------------------------------------------------------------
' Copyright ©1999-2007, Shyam Pillai, All Rights Reserved.
' --------------------------------------------------------------------------------
' You are free to use this code within your own applications, add-ins,
' documents etc but you are expressly forbidden from selling or
' otherwise distributing this source code without prior consent.
' This includes both posting free demo projects made from this
' code as well as reproducing the code in text or html format.
' --------------------------------------------------------------------------------

Option Explicit
Sub WordTableGen()
' I've used early binding in this example so do remember
' to set a reference to the Word object library.

Dim wdDoc As Word.Document
Dim wdRow As Word.Row
Dim wdColumn As Word.Column
Dim wdCell As Word.Cell
Dim pptSlide As PowerPoint.Slide
Dim pptShape As PowerPoint.Shape
Dim pptPres As PowerPoint.Presentation

Set pptPres = ActivePresentation
With pptPres
    Set pptSlide = .Slides.Add(.Slides.Count, ppLayoutBlank)
End With
With pptSlide.Shapes
Set pptShape = .AddOLEObject(Left:=120, _
                            Top:=110, _
                            Width:=480, _
                            Height:=320, _
                            ClassName:="Word.Document", _
                            Link:=msoFalse)
End With

Set wdDoc = pptShape.OLEFormat.Object
wdDoc.Tables.Add Range:=wdDoc.Range(0, 0), _
                    NumRows:=2, NumColumns:=2

On Error Resume Next
wdDoc.Tables(1).Range.Font.Size = 36
For Each wdRow In wdDoc.Tables(1).Rows
    For Each wdCell In wdRow.Cells
            wdCell.Range.Text = "Sample text in Cell(" & _
                wdCell.RowIndex & "," & wdCell.ColumnIndex & ")"
    Next wdCell
Next wdRow
wdDoc.Close True
wdDoc.Application.Quit
Set wdDoc = Nothing
End Sub

Native PowerPoint Table in PowerPoint 2000 or later

PowerPoint 2000 introduced the new native PowerPoint shape, which was more easily manipulated however in exchange we lost the functionality that MS Word provided. The example below explains how to insert a table shape, add rows, to add text in the cells, how to merge cells and also how to easily manipulate an individual cell by treating it as just as a PowerPoint shape. 

Top

' --------------------------------------------------------------------------------
' Copyright ©1999-2007, Shyam Pillai, All Rights Reserved.
' --------------------------------------------------------------------------------
' You are free to use this code within your own applications, add-ins,
' documents etc but you are expressly forbidden from selling or
' otherwise distributing this source code without prior consent.
' This includes both posting free demo projects made from this
' code as well as reproducing the code in text or html format.
' --------------------------------------------------------------------------------

Sub NativeTable()

    Dim pptSlide As Slide

    Dim pptShape As Shape

    Dim pptPres As Presentation

    Dim iRow As Integer

    Dim iColumn As Integer

    Dim oShapeInsideTable As Shape

    Set pptPres = ActivePresentation

    With pptPres

        Set pptSlide = .Slides.Add(.Slides.Count, ppLayoutBlank)

    End With

    With pptSlide.Shapes
 

        Set pptShape = .AddTable(NumRows:=3, _

                                 NumColumns:=5, _

                                 Left:=30, _

                                 Top:=110, _

                                 Width:=660, _

                                 Height:=320)

    End With

    With pptShape.Table

        For iRow = 1 To .Rows.Count

            For iColumn = 1 To .Columns.Count

                With .Cell(iRow, iColumn).Shape.TextFrame.TextRange

                    .Text = "Sample text in Cell"

                    With .Font

                        .Name = "Verdana"

                        .Size = "14"

                    End With

                End With

            Next iColumn

        Next iRow

    End With

' You can treat the table as a grouped shape too. Note that the 

' items within the table have indices in reverse order.

    With pptShape.GroupItems.Range(Array(1, 2, 3))

        With .Fill

            .Visible = True

            .BackColor.SchemeColor = ppFill

        End With

        With .TextFrame.TextRange.Font

            .Italic = True

            .Color.RGB = RGB(125, 0, 125)

        End With

    End With
 

' Let's look at how to merge cells in a native PowerPoint table

    With pptShape.Table

        ' Insert a row at the top of the table and set it's height

        .Rows.Add BeforeRow:=1

        .Rows(1).Height = 30

        ' Now merge all the cells of the Top row

        .Cell(1, 1).Merge .Cell(1, 5)

        ' Tip: To manipulate properties of individual cells in the table

        ' get a reference to the shape which represents the cell

        ' and then manipulate it just as any PowerPoint auto shape

        ' Now grab a reference of the shape which represents the merged cell

        Set oShapeInsideTable = .Cell(1, 1).Shape

        With oShapeInsideTable

            With .TextFrame.TextRange

                .Text = "Table of contents"

                .ParagraphFormat.Alignment = ppAlignCenter

                With .Font

                    .Bold = True

                    .Size = 20

                End With

            End With

            With .Fill

                .Patterned (msoPatternDashedHorizontal)

                .ForeColor.SchemeColor = ppShadow

                .BackColor.RGB = RGB(213, 156, 87)

                .Visible = True

            End With

        End With

    End With

End Sub

Top