lyahyaii, vos réponses sont "brèves"...
Sub Cellule2Shape()
Dim sh As Shape
With ActiveCell
Set sh = ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, .Left, .Top, .Width, .Height)
sh.TextFrame2.TextRange = .Value
sh.TextFrame2.VerticalAnchor = msoAnchorMiddle
sh.TextFrame2.HorizontalAnchor = msoAnchorCenter
sh.TextFrame2.WordArtformat = msoTextEffect31
sh.ShapeStyle = msoLineStylePreset13
.Clear
End With
End Sub
Sub Cell_To_Shape() 'D'où le Cell2Shape initial
Dim sh As Shape
With ActiveCell
Set sh = ActiveSheet.Shapes.AddTextbox(1, .Left, .Top, .Width, .Height)
With sh.TextFrame2
.TextRange = ActiveCell.Value: .VerticalAnchor = 3: .HorizontalAnchor = 2
.WordArtformat = 30: .TextRange.Font.Size = 20
End With
sh.ShapeStyle = 10013
.Clear
End With
End Sub
Sub testDessin()
ActiveSheet.DrawingObjects.Delete
Cells.Clear
[A1] = Date: [A1].Select
Formez_Les_Rangs msoShape32pointStar
[E1] = Time * Application.Pi(): [E1].Select
Formez_Les_Rangs msoShapeFlowchartMagneticDisk
End Sub
Private Sub Formez_Les_Rangs(TypeF As MsoAutoShapeType)
Dim sh As Shape
With ActiveCell
Set sh = ActiveSheet.Shapes.AddShape(TypeF, .Left, .Top, .Width, .Height)
With sh.TextFrame2
.TextRange = ActiveCell.Value: .VerticalAnchor = 3: .HorizontalAnchor = 2
.WordArtformat = 30: .TextRange.Font.Size = 20
End With
sh.ShapeStyle = 10013
.Clear
End With
End Sub
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