' _,
' ___ _ _ _ ___(_)
'/ __| / \ | \| | _ | |
'\__ \/ \ \| \\ | _ \ |
'|___/_/ \_|_|\_|___/_|
'
Option Explicit
#If VBA7 Then
#Else
Public Enum LongLong:[_]:End Enum
#If Win64 Then
#Else
Public Enum LongPtr:[_]:End Enum
#End If
#End If
Public Const PtrNull As LongPtr = 0
Private Type TypeArguments
Caller As Range
comment As String
cells As Variant
FontBold As Boolean
FontSize As Single
End Type
#If VBA7 Then
Private Declare PtrSafe Function SetTimer Lib "USER32" (ByVal hWnd As LongPtr, ByVal nIDEvent As LongPtr, ByVal uElapse As LongPtr, ByVal lpTimerFunc As LongPtr) As Long
Private Declare PtrSafe Function KillTimer Lib "USER32" (ByVal hWnd As LongPtr, ByVal nIDEvent As LongPtr) As Long
#Else
Private Declare Function SetTimer Lib "user32" (ByVal HWnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Private Declare Function KillTimer Lib "user32" (ByVal HWnd As Long, ByVal nIDEvent As Long) As Long
#End If
Private Works() As TypeArguments
Function LiveComment(value, ParamArray cells())
LiveComment = value
On Error Resume Next
Dim k%, rg: Set rg = Application.ThisCell
LiveComment = value
k = UBound(Works): k = k + 1: ReDim Preserve Works(1 To k)
With Works(k): Set .Caller = rg: .comment = value: .cells = cells: End With
Call SetTimer(0&, 0&, 0, AddressOf LiveComment_callback)
End Function
Private Sub LiveComment_callback(ByVal hWnd As LongPtr, ByVal wMsg As LongPtr, ByVal idEvent As LongPtr, ByVal dwTime As LongPtr)
On Error Resume Next
KillTimer 0&, idEvent
Dim lr&, UA%, i&, b As TypeArguments, cell
UA = UBound(Works)
For i = 1 To UA
b = Works(i)
For Each cell In b.cells
If TypeName(cell) = "Range" Then
cell.comment.Delete
cell.AddComment b.comment
With cell.comment
.Shape.TextFrame.AutoSize = 0
.Shape.TextFrame.AutoSize = 1
.Shape.Width = .Shape.Width + 10
End With
End If
Next
Next
Erase Works
On Error GoTo 0
End Sub
