VBA/Excel/Access/Word/Excel/Cell Comments

Clean the comment

   <source lang="vb">

Private Function CleanComment(author As String, cmt As String) As String

   Dim tmp As String
   tmp = Application.WorksheetFunction.Substitute(cmt, author & ":", "")
   tmp = Application.WorksheetFunction.Substitute(tmp, Chr(10), "")
   CleanComment = tmp

End Function

</source>
   
  

Converts docstring column into comments on name column.

   <source lang="vb">

Private Sub Workbook_AfterXmlImport(ByVal Map As XmlMap, ByVal IsRefresh As Boolean, ByVal Result As XlXmlImportResult)

   If Map.Name <> "application_Map" Then Exit Sub
   Dim cel As Range, ws As Worksheet, rng As Range
   Set ws = ThisWorkbook.Worksheets("Sheet1")
   Set rng = ws.ListObjects(1).ListColumns("name").Range
   For Each cel In rng
       If Not (cel.rument Is Nothing) Then cel.rument.Delete
       cel.AddComment cel.Offset(0, 1).Text
       rowID = cel.Row - rng.Row
   Next

End Sub

</source>
   
  

Count Comments

   <source lang="vb">

Sub CountComments()

   CommentCount = 0
   For Each cell In ActiveSheet.UsedRange
       On Error Resume Next
       x = cell.rument.Text
       If Err = 0 Then CommentCount = CommentCount + 1
   Next cell
   Debug.Print CommentCount

End Sub

</source>
   
  

Get the comment text

   <source lang="vb">

    Function GetCommentText(rCommentCell As Range)
    Dim strGotIt As String
        On Error Resume Next
        strGotIt = WorksheetFunction.Clean _
            (rCommentCell.rument.Text)
        GetCommentText = strGotIt
        On Error GoTo 0
    End Function

=GetCommentText(A1)

</source>
   
  

resize Comments

   <source lang="vb">

Sub CommentFitter1()

   Application.ScreenUpdating = False
   Dim x As range, y As Long
   
   For Each x In cells.SpecialCells(xlCellTypeComments)
       Select Case True
           Case Len(x.NoteText) <> 0
               With x.rument
                   .Shape.TextFrame.AutoSize = True
                   If .Shape.Width > 250 Then
                       y = .Shape.Width * .Shape.Height
                       .Shape.Width = 150
                       .Shape.Height = (y / 200) * 1.3
                   End If
               End With
       End Select
   Next x
   Application.ScreenUpdating = True

End Sub

</source>
   
  

Toggle Comments

   <source lang="vb">

Sub ToggleComments()

   If Application.DisplayCommentIndicator = xlCommentAndIndicator Then
       Application.DisplayCommentIndicator = xlCommentIndicatorOnly
   Else
       Application.DisplayCommentIndicator = xlCommentAndIndicator
   End If

End Sub

</source>
   
  

Tracking cell changes in a comment

   <source lang="vb">

Private Sub Worksheet_Change(ByVal Target As Excel.Range)

   For Each cell In Target
       With cell
           On Error Resume Next
           OldText = .rument.Text
           If Err <> 0 Then .AddComment
           MsgBox OldText & "Changed by " & Application.UserName & " at " & Now & vbLf
           .rument.Text NewText
           .rument.Visible = True
           .rument.Shape.Select
            Selection.AutoSize = True
           .rument.Visible = False
       End With
   Next cell

End Sub

</source>