Showing posts with label Excel Date Picker. Show all posts
Showing posts with label Excel Date Picker. Show all posts

Friday, January 1, 2010

Excel Macros : Excel Date Picker

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.

Photobucket



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

Download file with Excel Date Picker Utility