Excel und VBA: Formeln, Programmierung, Lösungen

Die Excel/VBA-Beispiele

Bewerten Sie hier bitte das Excel-Portal

Home Zurück Vor

Download Beispiel-Arbeitsmappe

Thema

Zellkontextmenü durch Jahreskalender ersetzen

Gruppe

Context

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.

Lösung

Geben Sie den Ereigniscode in das Klassenmodul der Arbeitsmappe ein.

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