This is first post of the year 2010, I wish all my blog readers a very happy and prospurous year. Today I am sharing Excel Date Picker Utility with you. Following picture will demonstrate some to the capabilities of this utility.
This utility will help you with following
1. In case you select a cell with date, or select any cell around the cell with a date. It will show floating button on the left side of the cell. If you click on the floating button it will show popup calender.
2. In case the cell already has a date , the calendar will show same date by default, else it will show current date.
3. You can jump the months by click on the month value on the popup calendar.
4. Click on the year will show spin buttons next to it and you can change year easily with spin buttons.
5. When you click on the date in popup calander, it will insert date clicked to the selected cell
6. You can also use Ctrl+Shift+d to show popup calender on your screen.
7. In case you get pop up calander and you do not want to click any date, just press Esc to close the pou up calendar.
This utility could be usefull in following ways
1. Many people end up entering date in text format as some time it is difficult to enter the date in correct computer readable format. With the popup calander, system takes care of the proper date entry.
2. Some times you have to get data from other users and you want them to enter dates in proper format so that rest of the worksheet can use those date inputs. With this utility you can be assured about this issue.
You may figure out many more usage based on your needs. The VBA code for Excel date Picker is available in the downloadable file. You can further modify the code as per your needs.
Now how to use this Excel Date Picker Utility
1. Download file and save it as Excel Addin on your machine.
2. You will need to
copy this code to worksheet module of your workbook.
You will need to add this code to show the Floating button. This code will creat the button in case it does not exist on it. All other features like cell menu on right click and popup calender on Ctrl+Shift+d will be available in case you do not add this code by saving download able file as Excel Addin on your machine. I am suggesting this because I still need to learn how to trigger worksheet selection change event with a vba code in addin.
Private Sub FloatingButton_Click()
Calander.Show
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Application.CutCopyMode = 1 Then
Exit Sub
ElseIf Target.Cells.Count > 1 Then
Exit Sub
Else
Set r = Target
Hasdate = 0
For x = -1 To 1
For y = -1 To 1
On Error GoTo Etrap1
If IsDate(r.Offset(x, y)) Then
Hasdate = 1
Exit For
End If
Rsume1:
Next y
If Hasdate = 1 Then Exit For
Rsume:
Next x
If Hasdate = 1 Then
FloatingButton.Left = r.Offset(0, 1).Left
FloatingButton.Top = r.Top
FloatingButton.Visible = True
Else
If Not FloatingButton.Visible = False Then
FloatingButton.Visible = False
End If
End If
Exit Sub
End If
Etrap1:
If r.Row = 1 Then
Resume Rsume
ElseIf r.Column = 1 Then
Resume Rsume1
End If
End Sub
Private Sub Worksheet_Activate()
Dim s As String
On Error Resume Next
s = ActiveSheet.FloatingButton.Caption
If Err.Number <> 0 Then
ActiveSheet.OLEObjects.Add(ClassType:="Forms.CommandButton.1", Link:=False _
, DisplayAsIcon:=False, Left:=147.75, Top:=34.5, Width:=15.75, Height:= _
15.75).Select
Selection.Name = "FloatingButton"
ActiveSheet.OLEObjects("FloatingButton").Object.Caption = ""
ActiveSheet.OLEObjects("FloatingButton").Object.BackColor = &H80000005
Range("A1").Select
FloatingButton.Visible = False
End If
On Error GoTo 0
End Sub
|
However this will not work on the files you send to other users. In that case you need to builtin the entire utility into the file you are sending out.
Following steps will help you to do this.
1. You will need to
copy this code to workbook module of your workbook
Private Sub Workbook_Open()
Dim NewControl As CommandBarControl
Application.OnKey "+^{D}", "Module1.ShowCalander"
On Error Resume Next
Application.CommandBars("Cell").Controls("Show Date Picker").Delete
On Error GoTo 0
Set NewControl = Application.CommandBars("Cell").Controls.Add
With NewControl
.Caption = "Show Date Picker"
.OnAction = "Module1.ShowCalander"
.BeginGroup = True
End With
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
On Error Resume Next
Application.CommandBars("Cell").Controls("Show Date Picker").Delete
End Sub
|
2. You will need to
copy this code to regular VBA module - Module1 of your workbook
Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Declare Function DrawMenuBar Lib "user32" (ByVal hwnd As Long) As Long
Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Declare Function ReleaseCapture Lib "user32" () As Long
Private Const GWL_STYLE As Long = (-16)
Private wHandle As Long
Sub ShowCalander()
Calander.Show
End Sub
|
3.
Move form named calander from the downloadable file to your file.
With these steps you can send the file to other users and it will work in similar way as it works on your machine.
In addition you can
force users to enable macros while using your file
37 comments: