Gruppe
Menue
Problem
Wie kann ich in einem Tabellenblatt festgelegte Kürzel in ein Kontextmenü einlesen lassen? Nach Aufruf des Kontextmenüs soll die Zelle mit dem ausgewählten Kürzel mit einem roten Hintergrund versehen werden.
ClassModule: DieseArbeitsmappe
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Call CmdDelete
End Sub
ClassModule: Tabelle1
Private Sub Worksheet_BeforeRightClick( _
ByVal Target As Range, Cancel As Boolean)
Dim oBar As CommandBar
Dim oBtn As CommandBarButton
Dim iRow As Integer
Cancel = True
On Error Resume Next
Application.CommandBars("KuerzelRot").Delete
On Error GoTo 0
Set oBar = Application.CommandBars.Add("KuerzelRot", msoBarPopup)
iRow = 1
Set oBtn = oBar.Controls.Add
oBtn.Caption = "Kürzel:"
Do Until IsEmpty(Worksheets("Kürzel").Cells(iRow, 1))
Set oBtn = oBar.Controls.Add
With oBtn
.Caption = Worksheets("Kürzel").Cells(iRow, 1)
.OnAction = "Faerben"
.Style = msoButtonCaption
If oBtn.Index = 2 Then .BeginGroup = True
End With
iRow = iRow + 1
Loop
oBar.ShowPopup
End Sub
StandardModule: basMain
Sub CmdDelete()
On Error GoTo ERRORHANDLER
Application.CommandBars("KuerzelRot").Delete
ERRORHANDLER:
End Sub
Sub Faerben()
Dim rng As Range
Dim sTxt As String
sTxt = Application.CommandBars("KuerzelRot") _
.Controls(Application.Caller(1) - 1).Caption
For Each rng In Range("A1:F16")
If rng.Value = sTxt Then
rng.Interior.ColorIndex = 3
End If
Next rng
End Sub