VBA-Programmierung in Microsoft Excel

Zellkontextmenü durch Jahreskalender ersetzen

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

    

Beiträge aus dem Excel-Forum zu den Themen Menue und Context