Thema: Tabellenblattbereich sortiert als Zellkontextmenü

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