Info bulle au survol d'une image

[goninph]

Bonjour,

J'ai trouvé ce code.

Qui peut le modifier en enlevant la boucle pour que la macro modifie seulement l'image sélectionnée ?

Ensuite j'adapterai le code avec un userform pour entrer le texte à afficher au survol de la souris.

Le but final est de sélectionner une image avec la souris et de lancer la macro via un raccourcis clavier, un userform s'ouvre et invite à saisir le texte qui s'affichera au survol de la souris

Merci pour votre aide et bon dimanche

Philippe


http://boisgontierjacques.free.fr/pa....htm#MouseMove

http://boisgontierjacques.free.fr/fi...llesImages.xls

Code: [Affichage]
Sub bulles()
For Each s In ActiveSheet.Shapes
If s.Type = 13 Then
ActiveSheet.Hyperlinks.Add Anchor:=s, Address:="", SubAddress:=""
s.Hyperlink.ScreenTip = s.Name
End If
Next s
End Sub

 

[BOISGONTIER]

Bonjour,

Sub BulleImageSelectionnée()
    NomShape = Selection.Name
    Bulle = InputBox("Quelle Bulle pour " & NomShape & "?")
    If Bulle = "" Then Bulle = NomShape
    Set s = ActiveSheet.Shapes(NomShape)
    ActiveSheet.Hyperlinks.Add Anchor:=s, Address:="", SubAddress:=""
    s.Hyperlink.ScreenTip = Bulle
End Sub

http://boisgontierjacques.free.fr/fichiers/Images/BullesImageSelection.xls


Boisgontier

 

[goninph]

Bonjour M. Boisgontier,

Nickel et merci.

J'ai un autre problème, le lien hypertexte empêche la macro affectée à l'image de ce lancer.

Voci le code corrigé

Encore merci pour le soutien et excellente soirée
Philippe

Option Explicit
Private Sub UserForm_Initialize()
    TextBox_InfoBulle = "Ligne1 " & vbCrLf & "Ligne2 " & vbCrLf & "Ligne3 " & vbCrLf & "Ligne4" 'Ajoute le symbole retour à la ligne
        Me.TextBox_InfoBulle.SetFocus   'Place le curseur dans la textbox
End Sub
Private Sub BT_OK_Click()
Unload Me
    Dim nomshape As Variant
    Dim s As Variant
    Dim Texte_de_la_bulle As Variant
    Texte_de_la_bulle = TextBox_InfoBulle
On Error GoTo Image_non_selectionnee
    nomshape = Selection.Name
    Set s = ActiveSheet.Shapes(nomshape)
    ActiveSheet.Hyperlinks.Add Anchor:=s, Address:="", SubAddress:=""
    s.Hyperlink.ScreenTip = Texte_de_la_bulle
Exit Sub
Image_non_selectionnee:
        MsgBox "Sélectionne une image avant de lancer la macro.", vbInformation, "Info"
End Sub
Private Sub BT_Annuler_Click()
Unload Me
End Sub
'Pour fermer l'UserForm avec le bouton ESC, le CommandButton1 est caché au bas de l'UserForm
'La propriété Cancel du CommandButton1 doit être à TRUE
Private Sub CommandButton1_Click()
Unload Me
End Sub

 

[BOISGONTIER]

>J'ai un autre problème, le lien hypertexte empêche la macro affectée à l'image de se lancer.

Je n'ai pas de solution simple (cf PJ).

-Soit ajouter du texte sur la photo
-Soit afficher une pseudo-bulle

En affichant les photos sur un formulaire (combien y en a t-il?):
-Il y a les controlTipText sur les images
-un module de classe pourrait simplfier:

http://boisgontierjacques.free.fr/fichiers/Images/FormPhotos1.xls
http://boisgontierjacques.free.fr/fichiers/Formulaire/FormPhotos.xls

Boisgontier