Excel und VBA: Formeln, Programmierung, Lösungen

Die Excel/VBA-Beispiele

Bewerten Sie hier bitte das Excel-Portal

Home Zurück Vor

Download Beispiel-Arbeitsmappe

Thema

Neuer Menüpunkt mit Kommentar-einfügen-Befehl

Gruppe

Button

Problem

Beim Öffnen der Arbeitsmappe soll dem "Einfügen"-Menü ein neuer Menüpunkt "XKommentar" hinzugefügt werden. Bei Anklicken des Menüpunktes wird ein neuer Kommentar mit vorgegebener Schriftformatierung und selektiertem Anwendernamen erstellt.

Lösung

Geben Sie den nachfolgenden Code in das Klassenmodul der Arbeitsmappe ein.

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 GoTo ERRORHANDLER
   oPopUp.Controls("XKommentar").Delete
ERRORHANDLER:
End Sub

Private Sub Workbook_Open()
   Dim oPopUpA As CommandBarPopup
   Dim oPopUpB As CommandBarControl
   Dim oBtn As CommandBarButton
   Set oPopUpA = Application.CommandBars("Worksheet Menu Bar") _
      .FindControl(ID:=30005)
   For Each oPopUpB In oPopUpA.Controls
        If InStr(WorksheetFunction _
         .Substitute(oPopUpB.Caption, "&", ""), _
         "Kommentar") Then Exit For
   Next oPopUpB
   On Error Resume Next
   oPopUpA.Controls("XKommentar").Delete
   On Error GoTo 0
   Set oBtn = oPopUpA.Controls.Add(before:=oPopUpB.Index + 1)
   With oBtn
      .Caption = "XKommentar"
      .OnAction = "SetComment"
      .FaceId = 1591
      .Style = msoButtonIconAndCaption
   End With
End Sub

StandardModule: basMain

Sub SetComment()
    Dim cmt As Comment
    Set cmt = ActiveCell.AddComment
    With cmt.Shape
        .Height = 80
        .Width = 120
        With .TextFrame
            With .Characters.Font
                .Size = 12
                .Bold = False
            End With
        End With
        .Visible = True
        SendKeys Application.UserName & ":+{home}"
        .Select
    End With
End Sub