Sub Test()
Dim iCol As Long
'boucler sur les 5 premières colonnes
For iCol = 1 To 5
'ajouter un rectange dans la cellule
AjouterRectange Cells(1, iCol), "Test" & iCol
'attendre 2 secondes
Application.Wait Now + TimeValue("00:00:02")
Next iCol
End Sub
Public Sub AjouterRectange(cellule As Range, Optional nomShape As String = "")
Dim laShape As Shape
'créer un rectangle sur la cellule
Set laShape = ThisWorkbook.Sheets(cellule.Parent.Name).Shapes.AddShape(msoShapeRectangle, cellule(1, 1).left, cellule(1, 1).top, cellule(1, 1).width, cellule(1, 1).height)
'modifier le nom du rectangle si un nom a été passé en paramètre
If nomShape <> "" Then laShape.Name = nomShape
End Sub