Gruppe
Menue
Problem
Im EINFÜGEN-Menü soll ein neuer Menüpunkt "Mein Kommentar" eingefügt werden, der das Erstellen eines Kommentars ohne vorgegebenen Anwendername ermöglicht.
ClassModule: DieseArbeitsmappe
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim oPopUp As CommandBarPopup
Set oPopUp = Application.CommandBars("Worksheet Menu Bar") _
.FindControl(ID:=30005)
On Error Resume Next
oPopUp.Controls("Mein Kommentar").Delete
On Error GoTo 0
Application.DisplayCommentIndicator = _
ThisWorkbook.Worksheets(1).Range("IV1")
ThisWorkbook.Worksheets(1).Range("IV1").ClearContents
End Sub
Private Sub Workbook_Open()
Dim oPopUp As CommandBarPopup
Dim oBtn As CommandBarButton
Set oPopUp = Application.CommandBars("Worksheet Menu Bar") _
.FindControl(ID:=30005)
On Error Resume Next
oPopUp.Controls("Mein Kommentar").Delete
On Error GoTo 0
Set oBtn = oPopUp.Controls.Add(before:=11)
With oBtn
.Caption = "Mein Kommentar"
.OnAction = "NewComment"
.FaceId = 2056
.Style = msoButtonIconAndCaption
End With
ThisWorkbook.Worksheets(1).Range("IV1") = _
Application.DisplayCommentIndicator
Application.DisplayCommentIndicator = xlCommentIndicatorOnly
End Sub
ClassModule: Tabelle1
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim cmt As Comment
For Each cmt In Comments
cmt.Visible = False
Next cmt
End Sub
StandardModule: basMain
Sub NewComment()
Dim oBtn As CommandBarButton
Set oBtn = _
Application.CommandBars.FindControl(ID:=1589)
oBtn.Execute
Set oBtn = _
Application.CommandBars.FindControl(ID:=1593)
oBtn.Execute
On Error Resume Next
ActiveCell.Comment.Shape.Select
End Sub