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-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
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