Sub CreeShapes()
i = 1
For Each c In ActiveSheet.Comments
With ActiveSheet.Shapes.AddShape(Type:=msoShapeCross, _
Left:=c.Parent.Left + c.Parent.Width - 9, Top:=c.Parent.Top, Width:=9, Height:=9)
.Fill.ForeColor.RGB = RGB(255, 255, 255)
.Line.ForeColor.RGB = RGB(255, 0, 0)
.Name = "commentaire" & i
i = i + 1
End With
Next
End Sub
Sub SupShapes()
For Each s In ActiveSheet.Shapes
If Left(s.Name, 11) = "commentaire" Then s.Delete
Next s
End Sub