Manipulating Tables in PowerPoint more...

Continuing from the earlier examples of table manipulation, this example tackles the issue of detecting which cells in a PowerPoint table have been selected. And then creates an array of the shapes which the selected cells represents to manipulate them.

Please note that while the procedure for detecting the selected cells works in both PPT 2000 as well as XP, certain methods like GroupItems is available in PPT 2002 and later only.

' --------------------------------------------------------------------------------
' Copyright ©1999-2022, 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

Const Example_Name = "Selected Cells Example"

Sub GetSelectedCells()

Dim CellArray() As String

Dim oTable As Table

Dim I As Integer, J As Integer





ReDim CellArray(1)

Set oTable = ActivePresentation.Slides(1).Shapes(1).Table

With oTable

    For I = 1 To .Rows.Count

    For J = 1 To .Columns.Count

      If .Cell(I, J).Selected Then

        ReDim Preserve CellArray(UBound(CellArray) + 1)

        CellArray(UBound(CellArray) - 1) = .Cell(I, J).Shape.Name

      End If

    Next J

    Next I

' This segment will work only in 2002 and later versions since I make use 

' of the GroupItems method to create a range of selected shapes. 

' In PPT2000 instead of creating the range, each shape can be processed individually.

 

    If UBound(CellArray) = 1 Then

      MsgBox "No cells are selected.", vbExclamation, Example_Name

      Exit Sub

    Else

      ReDim Preserve CellArray(UBound(CellArray) - 1)

      If MsgBox("There are " & UBound(CellArray) & " cells selected." & _

            "Do you wish to fill the colour?", _

                vbQuestion + vbYesNo, Example_Name) = vbYes Then

        With ActivePresentation.Slides(1).Shapes(1)

            With .GroupItems.Range(CellArray).Fill

                .Visible = True

                .ForeColor.RGB = RGB(125, 125, 255)

            End With

        End With

      End If

    End If

End With

End Sub