Sub testDessin_II()
ActiveSheet.DrawingObjects.Delete
Cells.Clear
[C3] = Date
Formez_Les_Rangs Range("C3"), msoShapeNonIsoscelesTrapezoid, 200, 200
[K8] = Application.UserName
Formez_Les_Rangs Range("K8"), msoShapeMoon, 400, 400
End Sub
Private Sub Formez_Les_Rangs(Cellule As Range, TypeF As MsoAutoShapeType, vW As Long, vH As Long)
Dim sh As Shape
With Cellule
Set sh = ActiveSheet.Shapes.AddShape(TypeF, .Left, .Top, vW, vH)
With sh.TextFrame2
.TextRange = Cellule.Value: .VerticalAnchor = 3: .HorizontalAnchor = 2
.WordArtformat = 30: .TextRange.Font.Size = 20
End With
sh.ShapeStyle = 10013
sh.LockAspectRatio = msoTrue
sh.ScaleHeight 0.95, msoFalse, msoScaleFromTopLeft
sh.ScaleWidth 0.95, msoFalse, msoScaleFromTopLeft
.Clear
End With
End Sub