Microsoft Excel

Excel und VBA: Formeln, Programmierung, Lösungen

Die Excel/VBA-Beispiele

Thema

Kontextmenü mit Buchungsvorgaben erstellen

Gruppe

Context

Problem

Wie kann ich beim Wechsel in ein Buchungsblatt ein Kontextmenü mit Einträgen aus einem Datenblatt erstellen lassen? Nach Auswahl eines Menüpunktes soll der entsprechende Datensatz eingetragen werden.

Lösung
Geben Sie den Ereigniscode in das Klassenmodul des Arbeitsblattes ein.

ClassModule: DieseArbeitsmappe

Private Sub Workbook_BeforeClose(Cancel As Boolean)
   Call CmdDelete
End Sub

ClassModule: Tabelle1

Private Sub Worksheet_Activate()
   Dim oCmdBar As CommandBar
   Dim oPopUp As CommandBarPopup
   Dim oBtn As CommandBarButton
   Dim iRow As Integer
   Call CmdDelete
   Set oCmdBar = Application.CommandBars.Add( _
      Name:="Buchen", Position:=msoBarPopup)
   With Worksheets("Vorgaben")
      For iRow = 1 To WorksheetFunction.CountA(.Columns("B"))
         If Not IsEmpty(.Cells(iRow, 1)) Then
            Set oPopUp = oCmdBar.Controls.Add(msoControlPopup)
            oPopUp.Caption = .Cells(iRow, 1)
         End If
         Set oBtn = oPopUp.Controls.Add
         oBtn.Caption = .Cells(iRow, 2)
         oBtn.OnAction = "Buchen"
         oBtn.Style = msoButtonCaption
      Next iRow
   End With
End Sub

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
   Cancel = True
   Application.CommandBars("Buchen").ShowPopup
End Sub

Private Sub Worksheet_Deactivate()
   Call CmdDelete
End Sub

StandardModule: basMain

Sub Buchen()
   Dim rngFind As Range
   Dim intCol As Integer
   If ActiveCell.Column > 3 Then
      Beep
      MsgBox "Sie müssen sich im Spaltenbereich ""A:C"" befinden!"
      Exit Sub
   End If
   With Worksheets("Vorgaben")
      Set rngFind = .Columns(2).Find(CommandBars("Buchen"). _
         Controls(Application.Caller(2)). _
         Controls(Application.Caller(1)).Caption, _
         lookat:=xlWhole, LookIn:=xlValues)
      For intCol = 1 To 3
         Cells(ActiveCell.Row, intCol) = rngFind.Offset(0, intCol - 1)
      Next intCol
   End With
End Sub

Sub CmdDelete()
   On Error GoTo ERRORHANDLER
   Application.CommandBars("Buchen").Delete
ERRORHANDLER:
End Sub

    

Beiträge aus dem Excel-Forum zu den Themen Menue und Context