AW: Mauszeiger Quickinfo
07.07.2008 13:55:00
Andi
Hi,
hier
https://www.herber.de/mailing/187802h.htm
gefunden.
Kopiere den Code ( Sub und Function) in ein Standard-Modul und führe die Prozedur test_fncCreateCommentIndicator aus. Dann wird die Farbe der vorhandenen Kommentar-Indikatoren auf Weiß gesetzt, so dass man sie nicht mehr sieht (außer dass oben rechts die Gitternetzlinien unterbrochen sind...)
Sub test_fncCreateCommentIndicator()
fncCreateCommentIndicator vbWhite, "pat"
End Sub
Private Function fncCreateCommentIndicator( _
CommentIndicatorColor As Long, _
CommentIndicatorName As String) As Boolean
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
If CommentIndicatorName = vbNullString Then GoTo ExitFunction
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(CommentIndicatorName)) = _
CommentIndicatorName 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 = CommentIndicatorName & 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
.Placement = xlMove
End With
Return
End Function
Schönen Gruß,
Andi