http://www.vbex.ru/index.php?action=history&feed=atom&title=VBA%2FExcel%2FAccess%2FWord%2FExcel%2FCell_Comments
VBA/Excel/Access/Word/Excel/Cell Comments - История изменений
2026-04-04T17:32:30Z
История изменений этой страницы в вики
MediaWiki 1.30.0
http://www.vbex.ru/index.php?title=VBA/Excel/Access/Word/Excel/Cell_Comments&diff=1638&oldid=prev
в 16:33, 26 мая 2010
2010-05-26T16:33:00Z
<p></p>
<table class="diff diff-contentalign-left" data-mw="interface">
<tr style="vertical-align: top;" lang="ru">
<td colspan="1" style="background-color: white; color:black; text-align: center;">← Предыдущая</td>
<td colspan="1" style="background-color: white; color:black; text-align: center;">Версия 16:33, 26 мая 2010</td>
</tr><tr><td colspan="2" style="text-align: center;" lang="ru"><div class="mw-diff-empty">(нет различий)</div>
</td></tr></table>
http://www.vbex.ru/index.php?title=VBA/Excel/Access/Word/Excel/Cell_Comments&diff=1639&oldid=prev
Admin: 1 версия
2010-05-26T12:47:39Z
<p>1 версия</p>
<p><b>Новая страница</b></p><div>==Clean the comment==<br />
<br />
<br />
<br />
<br />
<!-- start source code --><br />
<br />
<source lang="vb"><br />
<br />
Private Function CleanComment(author As String, cmt As String) As String<br />
Dim tmp As String<br />
tmp = Application.WorksheetFunction.Substitute(cmt, author & ":", "")<br />
tmp = Application.WorksheetFunction.Substitute(tmp, Chr(10), "")<br />
CleanComment = tmp<br />
End Function<br />
</source><br />
<br />
<br />
<br />
<br />
==Converts docstring column into comments on name column.==<br />
<br />
<br />
<br />
<br />
<!-- start source code --><br />
<br />
<source lang="vb"><br />
<br />
Private Sub Workbook_AfterXmlImport(ByVal Map As XmlMap, ByVal IsRefresh As Boolean, ByVal Result As XlXmlImportResult)<br />
If Map.Name <> "application_Map" Then Exit Sub<br />
Dim cel As Range, ws As Worksheet, rng As Range<br />
Set ws = ThisWorkbook.Worksheets("Sheet1")<br />
Set rng = ws.ListObjects(1).ListColumns("name").Range<br />
For Each cel In rng<br />
If Not (cel.rument Is Nothing) Then cel.rument.Delete<br />
cel.AddComment cel.Offset(0, 1).Text<br />
rowID = cel.Row - rng.Row<br />
Next<br />
End Sub<br />
</source><br />
<br />
<br />
<br />
<br />
==Count Comments==<br />
<br />
<br />
<br />
<br />
<!-- start source code --><br />
<br />
<source lang="vb"><br />
<br />
Sub CountComments()<br />
CommentCount = 0<br />
For Each cell In ActiveSheet.UsedRange<br />
On Error Resume Next<br />
x = cell.rument.Text<br />
If Err = 0 Then CommentCount = CommentCount + 1<br />
Next cell<br />
Debug.Print CommentCount<br />
End Sub<br />
</source><br />
<br />
<br />
<br />
<br />
==Get the comment text==<br />
<br />
<br />
<br />
<br />
<!-- start source code --><br />
<br />
<source lang="vb"><br />
<br />
Function GetCommentText(rCommentCell As Range)<br />
Dim strGotIt As String<br />
On Error Resume Next<br />
strGotIt = WorksheetFunction.Clean _<br />
(rCommentCell.rument.Text)<br />
GetCommentText = strGotIt<br />
On Error GoTo 0<br />
End Function<br />
=GetCommentText(A1)<br />
</source><br />
<br />
<br />
<br />
<br />
==resize Comments==<br />
<br />
<br />
<br />
<br />
<!-- start source code --><br />
<br />
<source lang="vb"><br />
<br />
Sub CommentFitter1()<br />
Application.ScreenUpdating = False<br />
Dim x As range, y As Long<br />
<br />
For Each x In cells.SpecialCells(xlCellTypeComments)<br />
Select Case True<br />
Case Len(x.NoteText) <> 0<br />
With x.rument<br />
.Shape.TextFrame.AutoSize = True<br />
If .Shape.Width > 250 Then<br />
y = .Shape.Width * .Shape.Height<br />
.Shape.Width = 150<br />
.Shape.Height = (y / 200) * 1.3<br />
End If<br />
End With<br />
End Select<br />
Next x<br />
Application.ScreenUpdating = True<br />
End Sub<br />
</source><br />
<br />
<br />
<br />
<br />
==Toggle Comments==<br />
<br />
<br />
<br />
<br />
<!-- start source code --><br />
<br />
<source lang="vb"><br />
<br />
Sub ToggleComments()<br />
If Application.DisplayCommentIndicator = xlCommentAndIndicator Then<br />
Application.DisplayCommentIndicator = xlCommentIndicatorOnly<br />
Else<br />
Application.DisplayCommentIndicator = xlCommentAndIndicator<br />
End If<br />
End Sub<br />
</source><br />
<br />
<br />
<br />
<br />
==Tracking cell changes in a comment==<br />
<br />
<br />
<br />
<br />
<!-- start source code --><br />
<br />
<source lang="vb"><br />
<br />
Private Sub Worksheet_Change(ByVal Target As Excel.Range)<br />
For Each cell In Target<br />
With cell<br />
On Error Resume Next<br />
OldText = .rument.Text<br />
If Err <> 0 Then .AddComment<br />
MsgBox OldText & "Changed by " & Application.UserName & " at " & Now & vbLf<br />
.rument.Text NewText<br />
.rument.Visible = True<br />
.rument.Shape.Select<br />
Selection.AutoSize = True<br />
.rument.Visible = False<br />
End With<br />
Next cell<br />
End Sub<br />
</source></div>
Admin