Gruppe
Menue
Problem
Wie kann ich das Zellkontextmenü durch den Kalender des aktuellen Jahres ersetzen? Bei Anklicken eines Tages soll das ausgewählte Datum in die aktive Zelle eingetragen werden.
ClassModule: DieseArbeitsmappe
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Call CmdDelete
End Sub
Private Sub Workbook_Open()
Dim oBar As CommandBar
Dim oCntr As CommandBarControl
Dim oBtn As CommandBarButton
Dim iMonth As Integer, iDay As Integer
Call CmdDelete
Set oBar = Application.CommandBars.Add("Datum", msoBarPopup)
Set oBtn = oBar.Controls.Add
With oBtn
.Caption = Year(Date)
.Style = msoButtonCaption
End With
For iMonth = 1 To 12
Set oCntr = oBar.Controls.Add(msoControlPopup)
oCntr.Caption = Format(DateSerial(Year(Date), iMonth, 1), "mmmm")
If iMonth = 1 Then oCntr.BeginGroup = True
For iDay = 1 To Day(DateSerial(Year(Date), iMonth + 1, 0))
Set oBtn = oCntr.Controls.Add
With oBtn
.Caption = iDay
.Style = msoButtonCaption
.OnAction = "Kalender"
End With
Next iDay
Next iMonth
End Sub
StandardModule: basMain
Sub Kalender()
ActiveCell.NumberFormat = "dd.mm.yyyy"
With CommandBars("Datum")
ActiveCell.Value = DateSerial(.Controls(1).Caption, _
Application.Caller(2) - 2, Application.Caller(1))
End With
End Sub
Sub CmdDelete()
On Error GoTo ERRORHANDLER
Application.CommandBars("Datum").Delete
ERRORHANDLER:
End Sub
ClassModule: Tabelle1
Private Sub Worksheet_BeforeRightClick( _
ByVal Target As Range, Cancel As Boolean)
Cancel = True
Application.CommandBars("Datum").ShowPopup
End Sub