Public Function fncCreateCommentIndicator(CommentIndicatorColor) As Boolean
'covers the comment indicators in the activeworkbook with a similar triangle
'of the specified color, based on the user name
Dim IDnumber As Long
Dim aCell As Range
Dim aComment As Comment
Dim aShape As Shape
Dim aWorksheet As Worksheet
Dim aWorkbook As Workbook
fncCreateCommentIndicator = False
On Error GoTo ExitFunction
Set aWorkbook = ActiveWorkbook
IDnumber = 0
For Each aWorksheet In aWorkbook.Worksheets
For Each aShape In aWorksheet.Shapes
If Left(aShape.Name, Len("CommentIndicator")) = "CommentIndicator" Then
aShape.Delete
End If
Next aShape
For Each aComment In aWorksheet.Comments
Set aCell = aComment.Parent
If InStr(1, aComment.Shape.TextFrame.Characters.Text, ":") > 0 Then
If Left(aComment.Shape.TextFrame.Characters.Text, _
InStr(1, aComment.Shape.TextFrame.Characters.Text, ":") - 1) = _
Application.UserName Then
GoSub CreateCommentIndicator
End If
End If
Next aComment
Next aWorksheet
fncCreateCommentIndicator = True
ExitFunction:
On Error GoTo 0
Set aCell = Nothing
Set aComment = Nothing
Set aShape = Nothing
Set aWorksheet = Nothing
Set aWorkbook = Nothing
Exit Function
CreateCommentIndicator:
Set aShape = aWorksheet.Shapes.AddShape(Type:=msoShapeRightTriangle, _
Left:=aCell.Left + aCell.Width - 5, Top:=aCell.Top, Width:=5, Height:=5)
IDnumber = IDnumber + 1
With aShape
.Name = "CommentIndicator" & CStr(IDnumber)
.IncrementRotation -180#
.Fill.Visible = msoTrue
.Fill.Solid
.Fill.ForeColor.RGB = CommentIndicatorColor
.Line.Visible = msoTrue
.Line.Weight = 1
.Line.Style = msoLineSingle
.Line.DashStyle = msoLineSolid
.Line.ForeColor.RGB = CommentIndicatorColor
End With
Return
End Function
Sub test_fncCreateCommentIndicator()
fncCreateCommentIndicator vbGreen
End Sub
[此贴子已经被作者于2005-8-18 1:21:54编辑过] |