Gruppe
Menue
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.
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