Working with PowerPoint tables
Note: If you use PowerPoint 2007, a lot of the example code below simply won't work. Microsoft hasn't finished hooking the new tables up to VBA. When they finish the job, we should be back in business.
How to change text, fill and other table properties
While you can set a PowerPoint table's position and size, you can't directly do much else with it. To get at the contents, you need to understand that PowerPoint treats a table as a kind of array of "cells".
To work with the cell in row three, column 2, for example, you'd address the table's .Cell(3,2) for example.
Each Cell has various properties; the one we're interested in is .Shape. A cell's .Shape property returns a PowerPoint shape that has all the properties of a normal PowerPoint rectangle.
So to change the text in our row three, column two cell we could do this if the table's currently selected:
With ActiveWindow.Selection.ShapeRange(1).Table
With .Cell(3,2).Shape
With .TextFrame.TextRange
.Text = "You found me!"
End With
End With
End With
Here's an example that demonstrates how to get at all the text in a table and how to change the color of cells:
Sub FunWithShapesInTable()
Dim oTbl As Table
Dim lRow As Long
Dim lCol As Long
' Get a reference to a table either programmatically or
' for demonstration purposes, by referencing the currently
' selected table:
Set oTbl = ActiveWindow.Selection.ShapeRange(1).Table
With oTbl
For lRow = 1 To .Rows.Count
For lCol = 1 To .Columns.Count
With .Cell(lRow, lCol).Shape
' Do something with each cell's text
If .HasTextFrame Then
If .TextFrame.HasText Then
Debug.Print .TextFrame.TextRange.Text
End If
End If
' do something with each cell ... set the fill:
.Fill.Visible = msoTrue
.Fill.ForeColor.RGB = RGB(255, 0, 0)
End With
Next ' column
Next ' row
End With
Set oTbl = Nothing
End Sub
Another set of examples that goes into more detail, allowing you to set cell border visibility, color, weight, to retrieve text from the current cell the cursor's in, to determine which cell the cursor's in and more:
Sub TableExamplesOne()
Dim oSh As Shape
Dim oTbl As Table
Dim lRowCount As Long
Dim lColumnCount As Long
Dim lBorderItem As Long
' This assumes that there's a table on the current slide
' and that the table or something in it is selected
Set oSh = ActiveWindow.Selection.ShapeRange(1)
With oSh
If .HasTable Then
Set oTbl = oSh.Table
With oTbl
Debug.Print .Rows.Count
Debug.Print .Columns.Count
' insert a new row (seems you can't insert one at end of table)
.Rows.Add (.Rows.Count)
' Change the first row cells
' Make them hideous so you can't possibly miss the
' results of running the macro ;-)
For lColumnCount = 1 To .Columns.Count
With .Cell(1, lColumnCount)
' set all cell borders to invisible
' as a precaution but color/weight them
For lBorderItem = 1 To 6
With .Borders(lBorderItem)
.Visible = msoFalse
.ForeColor.RGB = RGB(0, 255, 0)
.Weight = 6
End With
Next
' then set the ones we want visible
.Borders(ppBorderBottom).Visible = msoTrue
.Borders(ppBorderTop).Visible = msoTrue
.Borders(ppBorderLeft).Visible = msoTrue
.Borders(ppBorderRight).Visible = msoTrue
With .Shape
' fill with red
.Fill.Visible = msoTrue
.Fill.ForeColor.RGB = RGB(255, 0, 0)
' bold the text
.TextFrame.TextRange.Font.Bold = msoTrue
End With ' Shape
End With ' cell
Next ' cell
End With
End If
End With
End Sub
Sub TableExamplesTwo()
' can we work out the table or cell from text selected
' within a cell?
'
' This assumes that there's already a table on the slide and that
' text in the table is selected or that the insertion cursor
' is in a cell
Dim oSh As Shape
Dim oTbl As Table
Dim lRowCount As Long
Dim lColumnCount As Long
With ActiveWindow.Selection.TextRange
' note that you can work out an object's "ancestry" by
' walking up its parental chain. TypeName tells you
' what type of object is found at each level:
Debug.Print "======== Family Tree ========"
Debug.Print TypeName(.Parent)
Debug.Print TypeName(.Parent.Parent)
Debug.Print TypeName(.Parent.Parent.Parent)
' that lets us walk back up the tree to the shape
' that contains the selected text
Set oSh = .Parent.Parent
With oSh
Debug.Print "======== Current cell's text ========"
Debug.Print .TextFrame.TextRange.Text
End With
' but which cell is this?
' the currently selected SHAPE is the parent table
Set oTbl = ActiveWindow.Selection.ShapeRange(1).Table
With oTbl
For lRowCount = 1 To .Rows.Count
For lColumnCount = 1 To .Columns.Count
If .Cell(lRowCount, lColumnCount).Shape.Name = oSh.Name Then
' FOUND IT
Debug.Print "======== Current cell coordinates ========"
Debug.Print "Cursor is in cell at row: " & CStr(lRowCount) _
& " , column: " & CStr(lColumnCount)
End If
Next
Next
End With
End With
End Sub
If the user has selected multiple cells in a table, it gets a little tricky. In this case, PowerPoint tells you that the user has selected a single shape, the table that contains the cells that the user has actually selected.
That's not much use. But each cell has a .Selected property that returns True if the cell is selected. You can iterate through all the cells in the table, test each to see if .Selected is True and if so, do whatever else you need to do.
Sub DealWithMultipleSelectedCells()
Dim oSh As Shape
Dim oTbl As Table
Dim x As Long
Dim y As Long
With ActiveWindow.Selection
Select Case .Type
Case Is = ppSelectionShapes
If .ShapeRange(1).Type = msoTable Then
Set oTbl = .ShapeRange(1).Table
For x = 1 To oTbl.Columns.Count
For y = 1 To oTbl.Rows.Count
If oTbl.Cell(x, y).Selected Then
With oTbl.Cell(x, y).Shape
.Fill.ForeColor.RGB = RGB(255, 0, 0)
.Fill.Visible = True
End With
End If
Next
Next
End If
Case Is = ppSelectionText
' only a single cell selected
Case Is = ppSelectionSlides
' if you want to deal with selected slides, go for it
Case Is = ppSelectionNone
' nothing selected.
' ignore
End Select
End With
End Sub