XL 2019 Ajouter une info-bulle pour une sélection dans une liste déroulante

  • Initiateur de la discussion Initiateur de la discussion amgue
  • Date de début Date de début

amgue

XLDnaute Occasionnel
Bonjour à tous,

Comment afficher une info-bulle en fonction du choix sélectionné dans une liste déroulante (validation des données) ?

Merci d'avance.
 

Pièces jointes

C'est papy Mougeot !

XLDnaute Occasionnel
Bonjour,
On est obligé de passer par le VBA à mon avis.
Voici un essai . Ceci dit j'ai eu un peu de mal à le mettre en place car il y avait un espace à la fin de chaque valeur. Et VBA n'aime pas du tout. Je n'ai pas rectifié la seconde liste qui comprend des espaces.
 

Pièces jointes

Dernière édition:

cathodique

XLDnaute Barbatruc
Bonjour,
Ceci dit j'ai eu un peu de mal à le mettre en place car il y avait un espace à la fin de chaque valeur.
Dans l'aide on trouve ceci
LTrim, RTrim et Trim, fonctions, exemple

LTrim, RTrim et Trim, fonctions, exemple​


Cet exemple utilise les fonctions LTrim et RTrim pour éliminer respectivement les espaces se trouvant à gauche et à droite d'une variable chaîne. La fonction Trim permet d'éliminer les deux types d'espace.

Dim MyString, TrimString
MyString = " <-Trim-> " ' Initialise la chaîne.
TrimString = LTrim(MyString) ' TrimString = "<-Trim-> ".
TrimString = RTrim(MyString) ' TrimString = <-Trim->".
TrimString = LTrim(RTrim(MyString)) ' TrimString = "<-Trim->".
' L'utilisation de la fonction Trim seule produit le même résultat.
TrimString = Trim(MyString) ' TrimString = "<-Trim->".

il suffisait d'utiliser cette fonction pour éliminer les espaces.
juste cette ligne de ton code:
VB:
Select Case Trim(Me.Range("K5").Value)

Bon week-end.
 

fanch55

XLDnaute Barbatruc
Bonjour à tous,
Dans la même mouvance que @C'est papy Mougeot ! ,
code à mettre dans celui de la feuille :
VB:
Private Sub Worksheet_Change(ByVal Target As Range)
    Select Case Target.Address
        Case [K5].Address:  Set_Comment Target, Application.VLookup(Target, [Tbpaiement[Paiement]].Resize(, 2), 2, False)
        Case [K16].Address: Set_Comment Target, Application.VLookup(Target, [TbTag[Tag]].Resize(, 2), 2, False)
    End Select
End Sub
Sub Set_Comment(ByVal Target As Range, ByVal Text As String)
Dim Com
    With Target
        If Not .Comment Is Nothing Then .Comment.Delete
        With .AddComment(Replace(Text, ":", vbLf)).Shape.DrawingObject
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
            .AutoSize = True
            .Font.Italic = True
        End With
        T = Split(Text, ":")
        If UBound(T) = 1 Then
            With .Comment.Shape.TextFrame
                With .Characters(1, Len(T(0))).Font
                    .Color = vbBlue
                    .Bold = True
                    .Italic = False
                End With
                With .Characters(Len(T(0)) + 1, Len(T(1)) + 1).Font
                    .Color = vbBlack
                End With
            End With
        End If
   End With
End Sub

ou si le format du commentaire est peu important :
VB:
Private Sub Worksheet_Change(ByVal Target As Range)
    With Target
        Select Case .Address
            Case [K5].Address
                If Not .Comment Is Nothing Then .Comment.Delete
                .AddComment Application.VLookup(.Value, [Tbpaiement[Paiement]].Resize(, 2), 2, False)
                .Comment.Shape.TextFrame.AutoSize = True
            Case [K16].Address
                If Not .Comment Is Nothing Then .Comment.Delete
                .AddComment Application.VLookup(.Value, [TbTag[Tag]].Resize(, 2), 2, False)
                .Comment.Shape.TextFrame.AutoSize = True
        End Select
    End With
End Sub
 
Dernière édition:

job75

XLDnaute Barbatruc
Bonjour à tous,

Avec l'Info-bulle du lien fypertexte créé en K5 et K16 :
VB:
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
With [K5,K16]
    .Hyperlinks.Delete 'RAZ
    Hyperlinks.Add .Areas(1), "", .Areas(1).Address, ScreenTip:=Application.VLookup(.Areas(1), [F:G], 2, 0)
    Hyperlinks.Add .Areas(2), "", .Areas(2).Address, ScreenTip:=Application.VLookup(.Areas(2), [F:G], 2, 0)
    .Font.ColorIndex = xlAutomatic
    .Font.Underline = xlUnderlineStyleNone
    .Interior.ColorIndex = 6 'jaune
End With
End Sub
La macro s'exécute quand on modifie ou valide une cellule quelconque.

A+
 

Pièces jointes

Discussions similaires

Réponses
9
Affichages
449
Réponses
2
Affichages
207
Réponses
29
Affichages
794

Statistiques des forums

Discussions
315 285
Messages
2 118 023
Membres
113 412
dernier inscrit
Casi18