Calender

T

Troy

Is there anyway to pull up a calender so a user can select
a date versus having to manually enter a date?
 
R

Ron de Bruin

Hi Troy

Example for Calendar control

Do Insert-Object from the menubar and place a calendar control on your sheet.
It is possible you don't see it in the list, it is installed with Access.
So if you don't have that you possible don't have the control

Here a example to use

Place this in a Sheetmodule
If you select a cell in Column A the calendar will popup and when
you DblClick on the calendar the date will be placed in the activecell

Private Sub Calendar1_DblClick()
ActiveCell.NumberFormat = "m/d/yyyy"
ActiveCell = Calendar1
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Column = 1 Then
Calendar1.Left = Target.Left + Target.Width - Calendar1.Width
Calendar1.Top = Target.Top + Target.Height
Calendar1.Visible = True
Else: Calendar1.Visible = False
End If
End Sub


Example for one cell or a range

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Application.Intersect(Range("a1"), Target) Is Nothing Then
Calendar1.Left = Target.Left + Target.Width - Calendar1.Width
Calendar1.Top = Target.Top + Target.Height
Calendar1.Visible = True
Else: Calendar1.Visible = False
End If
End Sub
 
T

Troy

Thanks, just what I was looking for.

-----Original Message-----
Hi Troy

Example for Calendar control

Do Insert-Object from the menubar and place a calendar control on your sheet.
It is possible you don't see it in the list, it is installed with Access.
So if you don't have that you possible don't have the control

Here a example to use

Place this in a Sheetmodule
If you select a cell in Column A the calendar will popup and when
you DblClick on the calendar the date will be placed in the activecell

Private Sub Calendar1_DblClick()
ActiveCell.NumberFormat = "m/d/yyyy"
ActiveCell = Calendar1
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Column = 1 Then
Calendar1.Left = Target.Left + Target.Width - Calendar1.Width
Calendar1.Top = Target.Top + Target.Height
Calendar1.Visible = True
Else: Calendar1.Visible = False
End If
End Sub


Example for one cell or a range

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Application.Intersect(Range("a1"), Target) Is Nothing Then
Calendar1.Left = Target.Left + Target.Width - Calendar1.Width
Calendar1.Top = Target.Top + Target.Height
Calendar1.Visible = True
Else: Calendar1.Visible = False
End If
End Sub




--
Regards Ron de Bruin
(Win XP Pro SP-1 XL2002 SP-2)







.
 
Top