Sub Probe()
Dim s As Shape
Dim x As Double, y As Double
Dim mySh As Shape
Set mySh = ActiveShape
For Each s In ActivePage.Shapes
s.GetPosition x, y
If mySh.IsOnShape(x, y, -1) Then
s.Fill.UniformColor.CMYKAssign 0, 100, 0, 0
End If
mySh.RemoveFromSelection
Next s
End Sub