VBA-Programmierung in Microsoft Excel

Tutorial: Excel-Beispiele

Zellkontextmenü durch Jahreskalender ersetzen

Gruppe

Menue

Bereich

Context

Thema

Zellkontextmenü durch Jahreskalender ersetzen

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

    


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