Microsoft Excel

Excel und VBA: Formeln, Programmierung, Lösungen

Die Excel/VBA-Beispiele

Thema

Tabellenblattbereich sortiert als Zellkontextmenü

Gruppe

Context

Problem

Wie kann ich einen Tabellenblattbereich sortiert in ein in ein Zell-Kontextmenü übernehmen und dieses bei Klick mit der rechten Maustaste ausschließlich in Zelle B2 anzeiten lassen? Der jeweil ausgewählte Menüpunkt soll in Zelle B2 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_BeforeRightClick( _
   ByVal Target As Excel.Range, Cancel As Boolean)
   Dim oBar As CommandBar
   Dim oBtn As CommandBarButton
   Dim arrItems() As String
   Dim arrMenu As Variant
   Dim iRow As Integer, iRowM As Integer
   If ActiveCell.Address <> "$B$1" Then Exit Sub
   Cancel = True
   Call CmdDelete
   Set oBar = CommandBars.Add _
      (Name:="MyContext", Position:=msoBarPopup)
   iRow = 5
   Do Until IsEmpty(Cells(iRow, 5))
      iRowM = iRowM + 1
      ReDim Preserve arrItems(iRowM)
      arrItems(iRowM) = Cells(iRow, 5)
      iRow = iRow + 1
   Loop
   arrMenu = SortMenu(arrItems)
   For iRow = 1 To UBound(arrItems)
      Set oBtn = oBar.Controls.Add
      With oBtn
         .Caption = arrItems(iRow)
         .OnAction = "Eingabe"
         .Style = msoButtonCaption
      End With
   Next iRow
   oBar.ShowPopup
End Sub

Private Function SortMenu(arrItems)
   Dim iCount As Integer, iA As Integer, iB As Integer
   Dim sTmp As String
   iCount = UBound(arrItems)
   For iA = 1 To iCount
      For iB = iA + 1 To iCount
         If arrItems(iA) > arrItems(iB) Then
            sTmp = arrItems(iA)
            arrItems(iA) = arrItems(iB)
            arrItems(iB) = sTmp
         End If
      Next iB
   Next iA
   SortMenu = arrItems
End Function

StandardModule: basMain

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

Sub Eingabe()
   ActiveCell.Value = Application.CommandBars("MyContext").Controls(Application.Caller(1)).Caption
End Sub

    

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