Positionner un shape nouvellement créé

[Tiobi]

Bonjour,

Comment pourrais-je centrer automatiquement "Mon message xy" sur
l'écran vu que sa taille est fonction du texte ?

Merci de vos idées.

Sub Affiche_Message()
Dim shp As Shape
Dim Fin

Set shp = ActiveSheet.Shapes.AddTextEffect( _
PresetTextEffect:=msoTextEffect19, Text:="Mon message xy", _
FontName:="Gigi", FontSize:=30, _
FontBold:=msoFalse, FontItalic:=msoFalse, Left:=(Application.Width - 200) / 4, _
Top:=(Application.Height - 100) / 4)

Fin = Time + TimeSerial(0, 0, 4)
Do
DoEvents
Loop While Time < Fin
shp.Delete
End Sub

 

[pierrejean]

Re : Positionner un shape nouvellement créé

bonjour Tiobi

A tester:

Dim shp As Shape
Dim Fin
Set shp = ActiveSheet.Shapes.AddTextEffect( _
PresetTextEffect:=msoTextEffect19, Text:="Mon message xy test de large", _
FontName:="Gigi", FontSize:=30, _
FontBold:=msoFalse, FontItalic:=msoFalse, Left:=(Application.Width - 200) / 4, _
Top:=(Application.Height - 100) / 4)
[COLOR=blue]shp.Left = (Application.Width - shp.Width) / 2
[/COLOR]Fin = Time + TimeSerial(0, 0, 4)
Do
DoEvents
Loop While Time < Fin
shp.Delete

 

[Tiobi]

Re : Positionner un shape nouvellement créé

C'est OK.

Merci beaucoup pierrejean.