Kommentar Benutzername "Office"

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Intersect(Target, Sh.Cells(3, 5).Resize(Sh.Rows.Count - 2)) Is Nothing Then Exit Sub
Dim cmt As Comment
Dim strCmt As String
Dim lngTxt As Long
With Target
If .Value = "O" Then
strCmt = Environ("Username") & Chr(10) & Format(Date, "DD.MM.YYYY") & " " & Format( _
_
Time, "hh:mm") & ":" & Chr(10)
lngTxt = Len(Environ("Username"))
If Not .Comment Is Nothing Then .Comment.Delete     'alten Kommentar löschen
Set cmt = .AddComment(strCmt)
cmt.Visible = True  ' Kommentar einblenden
cmt.Shape.Width = 150
cmt.Shape.Height = 300
cmt.Shape.Select   ' Kommentarfeld aktivieren
With cmt.Shape.Fill
.Solid
'                 .ForeColor.RGB = RGB(191, 191, 191)
.Transparency = 0#
End With
With cmt.Shape.TextFrame.Characters.Font
.Name = "Tahoma"
.FontStyle = "Standard"
.Size = 9
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = True
.Underline = xlUnderlineStyleNone
End With
With cmt.Shape.TextFrame
.Characters(Start:=1, Length:=lngTxt).Font.FontStyle = "Fett"
.Characters(Start:=lngTxt + 2, Length:=16).Font.FontStyle = "Kursiv"
End With
End If
End With
Set cmt = Nothing
End Sub