|
Option Explicit
'-------------------------------------------------------
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'-------------------------------------------------------
Dim rngX As Range: Set rngX = Range("Sales[Employee]")
Dim oMemo As Comment
' delete memos
On Error Resume Next
For Each oMemo In Sheet1.Comments
oMemo.Delete
Next oMemo
On Error GoTo 0
'filtering
If Target.Cells.Count > 1 Then Exit Sub
If Application.Intersect(Target, rngX) Is Nothing Then Exit Sub
Dim vText As Variant
vText = Array(Target.Offset(0, 1).Value, Target.Offset(0, 2).Value, Target.Offset(0, 3).Value)
Set oMemo = Target.AddComment(Join(vText, Chr(10)))
With oMemo
.Visible = True
.Shape.TextFrame.HorizontalAlignment = xlHAlignCenter
.Shape.TextFrame.VerticalAlignment = xlVAlignCenter
End With
End Sub
|
|