Sub CréationCarré()
Dim Shp As Shape
Set Shp = ActiveSheet.Shapes.AddShape(msoShapeRectangle, 500 * Rnd, 400 * Rnd, 32, 32)
Action(Shp) = "CréationCercle"
End Sub
Sub CréationCercle()
Dim Shp As Shape
Set Shp = ActiveSheet.Shapes.AddShape(msoShapeOval, 500 * Rnd, 400 * Rnd, 35, 35)
Action(Shp) = "CréationCarré"
End Sub
Property Let Action(ByVal Shp As Shape, ByVal NomProc As String)
Shp.OnAction = NomProc
End Property