Private WithEvents myApp As Application
Dim CommentColl As Collection
Private Sub Class_Initialize()
Set myApp = Application
Set CommentColl = New Collection
ProcessMyComments True
End Sub
Public Sub myApp_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
ProcessMyComments False
ProcessMyComments True
End Sub
Private Sub ProcessMyComments(Create As Boolean)
Dim sht As Worksheet
Dim cmt As Comment
For Each sht In ActiveWorkbook.Sheets
For Each cmt In sht.Comments
If Create Then
CommentColl.Add sht.Name & "|" & cmt.Creator & "|" & cmt.Text
Else
CheckColl sht.Name & "|" & cmt.Creator & "|" & cmt.Text
End If
Next cmt
Next sht
End Sub
Private Function CheckColl(cmt As String) As String
Dim Gone As Boolean: Gone = True
For i = 1 To CommentColl.Count
If CommentColl(i) = cmt Then
Gone = False
End If
Next i
If Gone Then MsgBox "Comment changed or deleted:" & vbNewLine & Split(cmt, "|")(0) & vbNewLine & Split(cmt, "|")(1) & vbNewLine & Split(cmt, "|")(2)
End Function
Dim cmt As Comments
Private Sub Workbook_Open()
Set cmt = New Comments
End Sub
Option Explicit
Event OnCommentAdd(ByVal Cell As Range, ByRef Cancel As Boolean)
Event OnCommentDelete(ByVal Cell As Range, ByRef Cancel As Boolean)
Private WithEvents cmbrs As CommandBars
Private lCount As Long
Private oActiveCell As Range
Private Sub Class_Initialize()
lCount = ActiveSheet.Comments.Count
Set cmbrs = Application.CommandBars
End Sub
Private Sub cmbrs_OnUpdate()
Dim bCancel As Boolean
If lCount > ActiveSheet.Comments.Count Then
RaiseEvent OnCommentDelete(ActiveCell, bCancel)
End If
If lCount < ActiveSheet.Comments.Count Then
RaiseEvent OnCommentAdd(oActiveCell, bCancel)
End If
If bCancel Then
Set cmbrs = Nothing
Application.Undo
Set cmbrs = Application.CommandBars
End If
lCount = ActiveSheet.Comments.Count
Set oActiveCell = ActiveCell
End Sub
Option Explicit
Private WithEvents ThisWorkbook As ClsComments
Private Sub Workbook_Open()
Set ThisWorkbook = New ClsComments
End Sub
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
If ThisWorkbook Is Nothing Then
Set ThisWorkbook = New ClsComments
End If
End Sub
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Set ThisWorkbook = New ClsComments
End Sub
Private Sub Workbook_SheetDeactivate(ByVal Sh As Object)
Set ThisWorkbook = Nothing
End Sub
'PSEUDO EVENTS
Private Sub ThisWorkbook_OnCommentAdd(ByVal Cell As Range, ByRef Cancel As Boolean)
If MsgBox("A New Comment Was Added To Cell : " & Cell.Address(, , , True) & vbNewLine & vbNewLine & _
"Do You Want To Remove the Newly Added Comment ?", vbQuestion + vbYesNo) = vbYes Then
Cancel = True
End If
End Sub
Private Sub ThisWorkbook_OnCommentDelete(ByVal Cell As Range, ByRef Cancel As Boolean)
If MsgBox("The Comment In Cell : " & Cell.Address(, , , True) & " Has Been Removed." & vbNewLine & vbNewLine & _
"Do You Want To Restore the Deleted Comment ?", vbQuestion + vbYesNo) = vbYes Then
Cancel = True
End If
End Sub