The code below will insert an oval into the active cell. Any pointers on
how I could later test to see if a cell contains one or multiple shape
objects and then perform some action based on the result? Something along
the lines of:

' for each Shape in ActiveCell
' if shape = msoshapeoval then
' doOvalRoutine
' else
' if shape = msoshapediamond then
' doDiamondRoutine
' end if
' end if
' next


Option Explicit

Sub MakeOval()
' Based on work by Steve Conary and others

Dim myLeft, myTop, myHeight, myWidth, myOffset

If ActiveCell.Cells.Width ActiveCell.Cells.Height Then
myOffset = ActiveCell.Cells.Width * 0.05
Else
myOffset = ActiveCell.Cells.Height * 0.05
End If
myLeft = ActiveCell.Cells.Left + myOffset
myTop = ActiveCell.Cells.Top + myOffset
myHeight = ActiveCell.Cells.Height - 2 * myOffset
myWidth = ActiveCell.Cells.Width - 2 * myOffset
ActiveSheet.Shapes.AddShape(msoShapeOval, myLeft, myTop, myWidth,
myHeight). _
Select
Selection.ShapeRange.Line.ForeColor.SchemeColor = 10
Selection.ShapeRange.Line.Visible = msoTrue
Selection.ShapeRange.Line.Weight = 1
Selection.ShapeRange.Line.Visible = msoTrue
Selection.ShapeRange.Line.Style = msoLineSingle
Selection.ShapeRange.Fill.Visible = msoFalse

End Sub

Thanks,

Frank Hayes