Kontextmenü in der 
Entwicklungsumgebung erweitern

04.02.2002


 Auch in der Entwicklungsumgebung, also im VBA-Editor,  
kann man u.a. das Kontextmenü erweitern.
Ein Anwendungsbeispiel könnte das Einfügen
immer wieder benötigter Routinen sein.

In diesem Beispiel wird dem Kontextmenü der Eintrag "Tabellen durchlaufen"
hinzugefügt.
Wird dieser Menüpunkt aufgerufen wird an der aktuellen Cursorpostion
mittels SendKeys eine Schleife eingefügt, die alle Tabellen abarbeitet:
 
    For Each Tabelle In ActiveWorkbook.Sheets
        MsgBox Tabelle.Name
    Next Tabelle
 

Wichtig:
Setzen Sie zunächst einen Verweis auf "Microsoft Visual Basic for Applications Extensibility"
(siehe "Extras" - "Verweise")

Schritt 1
Fügen Sie diesen Code unter "DieseArbeitsmappe" ein: 

Private Sub Workbook_Open()
    Menü_löschen
    Menü_erstellen
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Menü_löschen
End Sub
 
Schritt 2
Fügen Sie diesen Code in einem neuen Modul ein (beispielsweise "Modul1"): 
Dim clsAddMenu As New clsMenue
Sub CodeEinfügen()
    SendKeys "For Each Tabelle In ActiveWorkbook.Sheets" & vbNewLine
    SendKeys vbTab & "MsgBox Tabelle.Name" & vbNewLine
    SendKeys "{HOME}" & ("Next Tabelle")
End Sub
Sub Menü_erstellen()
    clsAddMenu.AddMenuItem
End Sub
Sub Menü_löschen()
    Set clsAddMenu = Nothing
    On Error Resume Next
    Application.VBE.CommandBars("Code Window"). _
       Controls("For Each Tabelle...").Delete
End Sub
 
Schritt 3
Fügen Sie diesen Code in ein Klassenmodul ein.
Vergeben Sie diesem Klassenmodul den Namen "clsMenue" 
Public WithEvents Menue As VBIDE.CommandBarEvents
Public Sub AddMenuItem()
    Dim ctlTopMenu As CommandBarButton
    Set ctlTopMenu = Application.VBE.CommandBars("Code Window"). _
       Controls.Add(Type:=msoControlButton)
    ctlTopMenu.BeginGroup = True
    ctlTopMenu.Caption = "For Each Tabelle..."
    ctlTopMenu.Enabled = True
    Set Menue = Application.VBE.Events.CommandBarEvents(ctlTopMenu)
End Sub
Private Sub Menue_Click(ByVal cmdBar As Object, handled As Boolean, Cancel As Boolean)
    Call CodeEinfügen
End Sub