Voici mon code
Sub Ellipse3_Cliquer()
Dim t1 As Integer
Dim H%, HH, Mn As String
Dim s As Integer
Phrase = Range("a2").Value
Phrase = Replace(Phrase, " ", "00", 1): H = InStr(1, Phrase, "h") - 1
If IsNumeric(H) Then HH = Replace(Trim(Mid(" " & Phrase, H, 5)), "h", ":"): Mn = Right(HH, 2)
HH = Left(CStr(TimeValue(HH)), 5 + (Mn = "00") * 2)
HH = Replace(HH, ":", "h")
If Left(HH, 1) = 0 Then
HH = Right(HH, Len(HH) - 1)
End If
Select Case Len(HH)
Case Is = 5
t1 = 55
Case Is = 4
t1 = 50
Case Is = 3
t1 = 100
Case Is = 2
t1 = 35
End Select
ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, 30, 30, t1, 30).Select
Selection.Name = "Ma_zone"
Selection.ShapeRange.Fill.Visible = msoTrue
Selection.ShapeRange.Fill.Solid
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 27
Selection.ShapeRange.Fill.Transparency = 0#
Selection.ShapeRange.Line.Weight = 0.75
Selection.ShapeRange.Line.DashStyle = msoLineSolid
Selection.ShapeRange.Line.style = msoLineSingle
Selection.ShapeRange.Line.Transparency = 0#
Selection.ShapeRange.Line.Visible = msoTrue
Selection.ShapeRange.Line.ForeColor.SchemeColor = 64
Selection.ShapeRange.Line.BackColor.RGB = RGB(255, 255, 255)
Selection.Characters.Text = HH
With Selection.Characters(Start:=1, Length:=26).Font
.Name = "Arial"
.FontStyle = "Normal"
.Size = 14
.Bold = True
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 3
End With
ActiveSheet.Shapes.Range(Array("Ma_zone")).Select
Selection.ShapeRange.TextFrame2.TextRange.ParagraphFormat.Alignment = _
msoAlignCenter
'Positionne la zone de texte sur la cellule de copie. Pour l'exemple en B4
Selection.Top = Range("B24").Top
Selection.Left = Range("B24").Left
Call ZoneImage
End Sub
J'ai rajouté en fin de code le résultat obtenu avec l'enregistreur de macro
ActiveSheet.Shapes.Range(Array("Ma_zone")).Select
Selection.ShapeRange.TextFrame2.TextRange.ParagraphFormat.Alignment = _
msoAlignCenter
Ca ne bug pas mais ca ne centre pas non plus