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>