Back to jkp-ads.com |
Ron de Bruin
|
Ron de Bruin decided to remove all Windows Excel content from his website for personal reasons. If you want to know why, head over to rondebruin.nl.
Luckily, Ron was kind enough to allow me to publish all of his Excel content here.
Most of these pages are slightly outdated and may contain links that don 't work. Please inform me if you find such an error and I'll try to fix it.
Kind regards
Jan Karel Pieterse
TIP: I create an add-in for Windows and for the Mac, check out the Excel for Windows add-in here : https://jkp-ads.com/rdb/win/addins/datepicker.htm
This is the link to the add-in version for Mac Excel :
Below are some other links for you to check out if you are a Excel for Windows user:
Calendar Control for All Office versions - including Office 2010 64 bit https://sites.google.com/site/e90e50/calendar-control-class
Jim Cone's Date Picker on the site from Debra Dalgleish
http://www.contextures.com/exceldatepicker.html
A Pop-up Calendar for Excel 97-2003
http://www.fontstuff.com/vba/vbatut07_2003.htm
A Pop-up Calendar for Excel 2007 and up
http://www.fontstuff.com/vba/vbatut07.htm
Excel 97-2010, 2010 only the 32 bit version
Note: Read the info good, if you want a solution for all excel versions a custom calendar in a add-in is a better option, check out the links on top of this page for more information.
Excel 97-2003
Use Insert-Object on the Worksheet Menu
Bar.
Select the control in the list and press OK.
Excel
2007-2010
On the Developer tab use Insert > ActiveX
Controls….More controls.
Select the control in the list and press OK
Click on a cell on your worksheet.
Press the "Design Mode" button next to
the "Insert button" to turn of Design Mode.
Note: To display the
Developer tab in Excel 2007 go to Office Button >Excel Options...Popular
In Excel 2010 : File>Options..Customize Ribbon, check Developer in the Main
Tabs list on the right.
Excel 97-2010
It is
possible you don't see it in the list, because it is installed with Access
in Excel 97-2007. So if you don't have that program installed you possible
don't have the control. Note: The control is removed from
Office 2010 but you can register the 2007 version. This will only work in
Excel 2010 32 bit. If you don't have the control you can download it, see
the link on the bottom of this page.
Note 1: If you protect your sheet in Excel 97-2000 then
you must format the range first with the Date format you want and remove
this line ActiveCell.NumberFormat = "mm/dd/yyyy"
In Excel 2002 and up you be able to protect your worksheet and
allow Format cells.
Note 2: This code is not working
if there are Merged cells in the range, but you can use this:
Excel
97-2003: Format>Cells>Alignment Tab ... Center Across Selection. Excel
2007-2010: In the Cells group on the Home tab use : Format>Format
Cells>Alignment Tab ... Center Across Selection
After you insert the control on your sheet you can add the code in the worksheet module. Right click on the sheet tab and choose view code. Paste the code in the sheet module that is active now and press Alt-Q to go back to Excel. Note: Calendar1 in the code below is the name of the control.
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("A1:A20"), 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
If you select a cell in the Range A1:A20 the Calendar will popup and when
you Click on the calendar the Date will be placed in the active cell. If you
select a cell outside the range the Calendar will disappear.
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
Tip 1: If the cell
value is a Date and you want that the Calendar popup with that date selected
you can replace this line Calendar1.Value = Date
for
If Not IsDate(Target.Value) Then Calendar1.Value = Date Else Calendar1.Value = Target.Value End If
Tip 2: If you want that the calendar disappear when you
click on a date in the control you have two options. After ActiveCell.Select
in the Calendar_Click event add this line.
Calendar1.Visible = False
Or select a cell next to the date
cell, Replace ActiveCell.Select for:
ActiveCell.Offset(0, 1).Select
You can use the code below if you also want to insert the week number in
the active cell. The examples use the DblClick event to insert the week
number and week day in the cell.
Excel Week Number / Week
Day
If you also want a to be able to use the Calendar
control to add the Week Number and Week Day in the active cell you can copy
this event also in the sheet module.
Private Sub Calendar1_DblClick()
'This will insert the Weeknumber / Weekday in the cell
ActiveCell.Value = "W/D " & VBAWeekNum(Calendar1.Value, 1) & " - " & _
Application.WorksheetFunction.Weekday(Calendar1.Value, 1)
ActiveCell.Select
End Sub
If you DblClick on the Calendar the Week Number and Week Day will be
placed in the active cell. You also need the function below to use this.
Copy the function in a normal module of your workbook.
Alt-F11
Insert>Module in the menu bar
paste the Function below in this module
Alt-Q to go back to Excel
Function VBAWeekNum(D As Date, FW As Integer) As Integer VBAWeekNum = CInt(Format(D, "ww", FW)) End Function
ISO Week Number / Week Day
If you want to use the
ISO week number instead of the Excel week number then use the following
code.
Replace the Calendar1_DblClick event and the function of the
example above with
Private Sub Calendar1_DblClick()
'This will insert the ISO Weeknumber / Weekday in the cell
ActiveCell.Value = "W/D " & IsoWeekNum(Calendar1.Value) & " - " & _
Application.WorksheetFunction.Weekday(Calendar1.Value, 2)
ActiveCell.Select
End Sub
Public Function IsoWeekNum(d1 As Date) As Integer
' Daniel Maher
Dim d2 As Long
d2 = DateSerial(Year(d1 - Weekday(d1 - 1) + 4), 1, 3)
IsoWeekNum = Int((d1 - d2 + Weekday(d2) + 5) / 7)
End Function
Download the control from MVP Graham Mayor's site and read the
information in the PDF that you also find in the download good so you know
how to register the control. Note: The 2007 version will also work in Excel
2010 32 bit but not in Excel 2010 64 bit
http://www.gmayor.com/Zips/MSCAL.zip