' ===================================================
' Code by Martin Green eMail
' Visit my Office Tips web site at
' ===================================================
Private Sub Workbook_Open2()
Dim NewControl As CommandBarControl
' Assign shortcut to display calendar on SHIFT+CTRL+C
Application.OnKey "+^{C}", "Module1.OpenCalendar"
' Add item to shortcut menu on open
On Error Resume Next
Application.CommandBars("Cell").Controls("Insert Date").Delete
On Error GoTo 0
Set NewControl = Application.CommandBars("Cell").Controls.Add
With NewControl
.Caption = "Insert Date"
.OnAction = "Module1.OpenCalendar"
.BeginGroup = True
End With
End Sub
Private Sub Workbook_BeforeClose2(Cancel As Boolean)
' Delete item from shortcut menu on close
On Error Resume Next
Application.CommandBars("Cell").Controls("Insert Date").Delete
End Sub
----------------------
i usually use button to pop up calender which is attached in forms but this works whenever the mouse set in any cell how can i make it fixed on certain Cell
' Code by Martin Green eMail
' Visit my Office Tips web site at
' ===================================================
Private Sub Workbook_Open2()
Dim NewControl As CommandBarControl
' Assign shortcut to display calendar on SHIFT+CTRL+C
Application.OnKey "+^{C}", "Module1.OpenCalendar"
' Add item to shortcut menu on open
On Error Resume Next
Application.CommandBars("Cell").Controls("Insert Date").Delete
On Error GoTo 0
Set NewControl = Application.CommandBars("Cell").Controls.Add
With NewControl
.Caption = "Insert Date"
.OnAction = "Module1.OpenCalendar"
.BeginGroup = True
End With
End Sub
Private Sub Workbook_BeforeClose2(Cancel As Boolean)
' Delete item from shortcut menu on close
On Error Resume Next
Application.CommandBars("Cell").Controls("Insert Date").Delete
End Sub
----------------------
i usually use button to pop up calender which is attached in forms but this works whenever the mouse set in any cell how can i make it fixed on certain Cell
Last edited by a moderator: