Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 5 And Target.Count = 1 Then
Dim pos(1 To 11)
Target.ClearComments
p = Application.Match(Target, Application.Index([clients], , 1), 0)
If Not IsError(p) Then
pos(1) = 1
For i = 2 To 11
tmp = tmp & [clients].Cells(p, i) & vbLf
pos(i) = pos(i - 1) + Len([clients].Cells(p, i)) + 1
Next i
Target.AddComment Text:=tmp
Target.Comment.Shape.TextFrame.AutoSize = True
With Target.Comment.Shape.TextFrame.Characters(Start:=pos(7), Length:=Len([clients].Cells(p, 8)) + 1).Font
.Name = "Verdana"
.Size = 8
.Bold = True
.ColorIndex = 3
End With
End If
End If
End Sub
Maj si BD modifiée:
Private Sub Worksheet_Activate()
Dim pos(1 To 11)
For Each c In Range("e2:e" & [e65000].End(xlUp).Row)
c.ClearComments
p = Application.Match(c, Application.Index([clients], , 1), 0)
If Not IsError(p) Then
pos(1) = 1
tmp = ""
For i = 2 To 11
tmp = tmp & [clients].Cells(p, i) & vbLf
pos(i) = pos(i - 1) + Len([clients].Cells(p, i)) + 1
Next i
c.AddComment Text:=tmp
c.Comment.Shape.TextFrame.AutoSize = True
With c.Comment.Shape.TextFrame.Characters(Start:=pos(7), Length:=Len([clients].Cells(p, 8)) + 1).Font
.Name = "Verdana"
.Size = 8
.Bold = True
.ColorIndex = 3
End With
End If
Next
End Sub