Const Nom = "shpAutour"
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
Dim shp, monshp As Shape
Application.ScreenUpdating = False
With Sh
For Each shp In .Shapes
If shp.Name = Nom Then shp.Delete
Next shp
Set monshp = .Shapes.AddShape(msoShapeRoundedRectangle, 2874.75, 7009.5, 77.25, 36.75)
monshp.Name = Nom: monshp.Fill.Visible = msoFalse
With monshp.Line: .Visible = msoTrue: .Transparency = 0: .ForeColor.RGB = RGB(255, 0, 0): End With
monshp.Width = ActiveCell.Width + 10: monshp.Height = ActiveCell.Height + 10
monshp.Top = ActiveCell.Top + ActiveCell.Height / 2 - monshp.Height / 2
monshp.Left = ActiveCell.Left + ActiveCell.Width / 2 - monshp.Width / 2
monshp.OnAction = "thisworkbook.Efface"
End With
End Sub
Public Sub Efface()
ActiveSheet.Shapes(Nom).Delete
End Sub