XL 2013 info bulle au survol de la souris

[Usine à gaz]

Bonjour à toutes est à tous,

J'ai un nouveau besoin pour lequel je me permets de vous faire à nouveau appel.

Pour prévenir l'utilisateur d'une possibilité d'action, j'ai besoin d'une info bulle (durée maxi 1 sec idéalement 1/2 seconde)
qui s'affiche au survol de la souris d'une plage de cellules (dans le fichier test de d4 à d30)

Bien sûr, il y a la possibilité de mettre des commentaires dans les cellules mais sur 50,000 lignes, c'est peut-être lourd pour le fichier... d'autant plus que certaines cellules contiennent déjà des commentaires.

J'ai fait des recherches sur le net (forums et vidéos) je n'ai rien trouvé qui me corresponde et je ne vois pas comment faire.

Alors, je fais appel aux magiciens LOL.
Auriez-vous une solution ?
En cas, je joins un fichier test.

Avec mes remerciements pour vos aides toujours si précieuses,
Amicalement,
arthour973,

 

[Staple1600]

Bonjour le fil, le forum

@arthour973
Une possibilité "basique"
(à mettre dans le code de la feuille)

Private Sub Worksheet_SelectionChange(ByVal r As Range)
Dim InfoBulle$
InfoBulle = "Ligne 1" & Space(10) & vbNewLine & "Ligne2"
If Not Intersect(r, Range("D4:D30")) Is Nothing Then
r.Hyperlinks.Delete
ActiveSheet.Hyperlinks.Add Anchor:=r, Address:="", SubAddress:="", ScreenTip:=InfoBulle
Else
ActiveSheet.Hyperlinks.Delete
End If
End Sub

PS: Ton moteur de recherche doit être "grippé"...

 

[Usine à gaz]

Bonjour Jm,

J'ai fait beaucoup de recherches ......

Merci d'être encore là et pour ton code.
Mais cela ne correspond pas à mon besoin car il s'exécute au clic et mon besoin est au survol de la souris.
Amicalement,
arthour973

 

[Staple1600]

Re

@arthour973
1)Tu parles d'infobulle, or pour Excel une infobulle est liée au au lien hypertexte.
2) J'ai écris "possibilité "basique"
3) tu pinailles (clic ou survol, tu voulais une info-bulle tu l'as )

 

[Usine à gaz]

Merci JM de me répondre encore une fois.
Mais je ne pinaille pas car c'est vraiment au survol que j'en ai besoin avec la souris et pas au clic

 

[Staple1600]

Re,

@arthour973
Puisque tu as fais des recherches, tu as du faire celle-ci
"MouseMove(ByVal Button As Integer"
Si oui tu as compris que cela oblige à rajouter (donc alourdir) des objets pour avoir un événement Survol.

Ce qui explique ma proposition précédente (qui évite de se compliquer la vie)

PS: L'info-bulle est unique (ou changera en fonction de la cellule survolée) ?

 

[Si...]

Bon_soir
Un exemple de tour de passe-passe avec le fichier joint.
mais pour appuyer les dires de Stapple qui n'aime pas les usines à gaz

Re,
@arthour973
Si oui tu as compris que cela oblige à rajouter (donc alourdir) des objets pour avoir un événement Survol.

à éviter pour 5 000 lignes ! (les passes seront trés chargées)

 

[Staple1600]

Re, Bonjour Si...

En plus d'appuyer mes dires, tu as trop appuyé sur la touche p
(C'est Staple pas Stapple)

Le shape s'affiche avec MouseOver, certes mais comment on fait pour écrire quelque chose dans la cellule?
Avec la plage donnée dans l'exemple d'arthour973: Range("D4:D30)
On est déjà rendu à 26 shapes.

Et effectivement, le gaz, de nouveau de mes narines, s'approche.
(mais ce n'est pas un problème, c'est le classeur d'arthour pas le mien)

 

[Staple1600]

Re

Histoire d'aérer mes archives (même si il ne s'agit pas de survol), ici on utilise qu'un seul shape qui se déplace en suivant la cellule active)
Comme cela ne conviendra pas à arthour*, je le poste pour les ceusses que cela pourra intéresser
(c'est pas moi qui le dit, c'est lui dans le message#5 )
(à mettre dans Thisworkbook)

Option Explicit
Private Sub Workbook_SheetDeactivate(ByVal Sh As Object)
On Error GoTo Shape_Deleted
Sh.Shapes("InfoBulle").Delete
Shape_Deleted:
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
'source:[-160310-DaCat1997-]
'adaptation Staple, le 21/5/18 pour arthour973
Dim TopIs&, LeftIs&, i%
If Not Intersect(Target, Range("D4:D30")) Is Nothing Then
        On Error GoTo Shape_Does_Not_Exist
        With Sh.Shapes("InfoBulle")
            For i = 1 To Target.Row
                TopIs = TopIs + Sh.Cells(i, 1).RowHeight
            Next i
            .Top = TopIs - 22
            For i = 1 To Target.Column
                LeftIs = LeftIs + (Sh.Cells(1, i).ColumnWidth * 5.7)
            Next i
            .Left = LeftIs
            .OLEFormat.Object.Text = "Bonjour," & Application.UserName
            .Visible = msoTrue
            .TextFrame2.VerticalAnchor = 3 ' à commenter si plantage (selon version XL)
            .TextFrame2.HorizontalAnchor = 2' à commenter si plantage  (selon version XL)
        End With
    Else
    On Error GoTo Shape_Deleted
    Sh.Shapes("InfoBulle").Delete
End If
Exit Sub
Shape_Does_Not_Exist:
On Error GoTo 0
Sh.Shapes.AddShape(msoShapeLeftArrow, 0, 0, 115, 30).Name = "InfoBulle"
Resume
Shape_Deleted:
End Sub

 

[Lone-wolf]

Bonsoir à tous

@Staple1600

En plus d'appuyer mes dires, tu as trop appuyé sur la touche p

le gaz de nouveau de mes narines s'approche

Ce ne serait pas plutôt : le gaz, des trous de mes narines, s'approche?

 

[Staple1600]

Re

@Lone-wolf
Tu as un trou en trop...comme j'avais des virgules en moins
(voir ici)

 

[Lone-wolf]

RE

@Staple1600 Wath!!. Si tu as un trou dans ton nez, c'est que t'es bizarre.

 

[eriiic]

Bonjour à tous,

Bien sûr, il y a la possibilité de mettre des commentaires dans les cellules mais sur 50,000 lignes, c'est peut-être lourd pour le fichier...

Que ton texte soit dans un commentaire ou ailleurs il sera de toute façon présent dans le fichier.
Je crois que tu compliques inutilement.
eric

 

[Usine à gaz]

Bjr JM,
Bjr Si,
Chalut Lone,
A toutes et à tous,

Je suis désolé de mon retour si tardif, j'ai eu un souci de santé ...... ça va mieux maintenant Merci LOL
Je reviens donc avec joie et plaisir de vous retrouver.

Ce lien n'existe plus : Il est super ton code et c'est bien ça : apparition au survol de la souris
Mais je ne sais pas le modifier pour que ce soit un message qui apparaisse.
Bon WE à toutes et à tous,
Amicalement,
arthour973

 

[Staple1600]

Bonjour le fil, le forum

@arthour973
Pas de commentaires sur le code du message#9?
J'en déduis que tu ne l'as pas testé...
Ni investiguer plus avant sur ce que j'évoquais dans le message#6 ?

Puisque tu as fais des recherches, tu as du faire celle-ci
"MouseMove(ByVal Button As Integer"