Dans l'aide on trouve ceciCeci dit j'ai eu un peu de mal à le mettre en place car il y avait un espace à la fin de chaque valeur.
Select Case Trim(Me.Range("K5").Value)
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
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
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