Calendar Popup

[NFL]

I have a calendar object referenced to cell E1. I also have the window
freeze panes locked at row 8. Is there a way I can have the calendar popup
appear below row 8? The problem I'm facing is that the last 2 weeks of any
given month can not be selected because the object crosses below row 8.

Thank you for your help

 

[Jim Thomlinson]

By calendar object what exactly are you referring to. I am going to assume
the Microsoft Month View Control from the Control toolbox. Have you tried
switching to a date time picker control? It does not seem to have an issue
with freezing.

 

[NFL]

It appears the same, but I went to the 'Insert', 'Object', from the menu bar
and picked the calendar from there. Are the codes written different for the
date time picker?

Thank you,

 

[Ron de Bruin]

You can change the position of the calendar in the code if you want
Show me the code that you use now

--

Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm

 

[NFL]

This code works only on Cell E1. Every time I click on that cell, the
calendar will appear directly below Cell E1. Is there a way to have the
calendar appear below row 8?

Private Sub Calendar1_Click()
ActiveCell.Value = CDbl(Calendar1.Value)
'ActiveCell.NumberFormat = "dddd, mmmm dd, yyyy"
ActiveCell.Select
Calendar1.Visible = False
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
If Not Application.Intersect(Range("E1"), Target) Is Nothing Then
Calendar1.Left = Target.Left + Target.Width - Calendar1.Width
Calendar1.Top = Target.Top + Target.Height
Calendar1.Visible = True
' select Today's date in the Calendar
Calendar1.Value = Date
ElseIf Calendar1.Visible Then Calendar1.Visible = False
End If
End Sub

 

[Ron de Bruin]

Hi NFL

Use this to display it below row 8

Private Sub Calendar1_Click()
ActiveCell.Value = CDbl(Calendar1.Value)
ActiveCell.NumberFormat = "mm/dd/yyyy"
ActiveCell.Select
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
If Not Application.Intersect(Range("E1"), Target) Is Nothing Then
Calendar1.Left = Target.Left + Target.Width - Calendar1.Width
Calendar1.Top = Target.Offset(7, 0).Top + Target.Height
Calendar1.Visible = True
' select Today's date in the Calendar
Calendar1.Value = Date
ElseIf Calendar1.Visible Then Calendar1.Visible = False
End If
End Sub


You can use it for more cells also

Note: You can use this if your range is not one area
If Not Application.Intersect(Range("A1:A20,C1,E1"), Target) Is Nothing Then



--

Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm