Gruppe
Menue
Problem
Dem Zell-Kontextmenü wurde ein Menü "Zahlungsbedingungen" mit den Schaltflächen "14 Tage" und "30 Tage" hinzugefügt. Bei Anklicken wird die Zahlungsweise eingetragen.
ClassModule: DieseArbeitsmappe
Private Sub Workbook_BeforeClose(Cancel As Boolean)
On Error Resume Next
Application.CommandBars("Cell") _
.Controls("Zahlungsbedingungen").Delete
On Error GoTo 0
End Sub
Private Sub Workbook_Open()
Dim oPopUp As CommandBarControl
Dim oBtn As CommandBarButton
With Application.CommandBars("Cell")
On Error Resume Next
.Controls("Zahlungsbedingungen").Delete
On Error GoTo 0
Set oPopUp = .Controls.Add(msoControlPopup)
End With
oPopUp.Caption = "Zahlungsbedingungen"
Set oBtn = oPopUp.Controls.Add
With oBtn
.Caption = "14 Tage"
.OnAction = "SetPayment"
.Style = msoButtonCaption
End With
Set oBtn = oPopUp.Controls.Add
With oBtn
.Caption = "30 Tage"
.OnAction = "SetPayment"
.Style = msoButtonCaption
End With
End Sub
StandardModule: Modul1
Sub SetPayment()
ActiveCell.Value = _
"Zahlungsbedingungen: " & _
Application.CommandBars("Cell") _
.Controls("Zahlungsbedingungen") _
.Controls(Application.Caller(1)).Caption
End Sub