Sub AjuRec()
Dim Sh As Shape, CHau As Range
Set Sh = ActiveSheet.Shapes(Application.Caller)
Set CHau = Sh.TopLeftCell
Do While Not IsEmpty(CHau.Value): Set CHau = CHau.Offset(-1, 0): Loop
Do While IsEmpty(CHau.Value): Set CHau = CHau.Offset(1, 0): Loop
Set CBas = CHau
Do While Not IsEmpty(CBas.Value): Set CBas = CBas.Offset(1, 0): Loop
Do While IsEmpty(CBas.Value): Set CBas = CBas.Offset(-1, 0): Loop
Sh.Left = CHau.Left + 6: Sh.Width = CHau.Width - 12
Sh.Top = CHau.Top - 3: Sh.Height = CBas.Offset(1, 0).Top + 3 - Sh.Top
End Sub
Sub AjuRec()
AjuUnShape ActiveSheet.Shapes(Application.Caller)
End Sub
Sub LesFaireTous()
Dim Sh As Shape
For Each Sh In ActiveSheet.Shapes: AjuUnShape Sh: Next Sh
End Sub
Private Sub AjuUnShape(ByVal Sh As Shape)
Dim Cel As Range, CBas As Range
Set Cel = Sh.TopLeftCell
Sh.Left = Cel.Left + 6
Do While Not IsEmpty(Cel.Value): Set Cel = Cel.Offset(-1, 0): Loop
Do While IsEmpty(Cel.Value): Set Cel = Cel.Offset(1, 0): Loop
Sh.Width = Cel.Width - 12
Sh.Top = Cel.Top - 3
Do While Not IsEmpty(Cel.Value): Set Cel = Cel.Offset(1, 0): Loop
Sh.Height = Cel.Top + 3 - Sh.Top
End Sub
Merci pour vos réponses
@Dranreb :
pour l'usage du document derrière et ma connaissance des macros, je n'utiliserais pas ta macro mais merci quand même
@joney :
tu "fais" des "belles bulles"
aussi, je n'arrive pas à faire correctement une info-bulle
je souhaiterais par exemple lors du survol d'une cellule ( et non si possible lors de la sélection de celle ci )
en J 24, lors du survol du pointeur , qu'une info-bulle apparaisse avec le terme 1.17 ( car cela evite de lire les coordonnées en bas de tableau )
en j24, 1.17
en O18, 2.23
...
edit :
@joney
comment as tu fais pour avoir ton texte lors du survol de la bulle ?