Simulating Date Picker in ADF Desktop Integration

About

ADF Desktop Integration doesn't have built-in Date-Picker like component to choose a date from the calendar instead of entering it manually as in ADF Faces.

In this Article, I would like to discuss how an ADF Input Text component can be made use as a Calendar component using the power of excel macros.

Usecase

Let us take a simple case of Employee form with Hiredate field as date-picker

Solution

Assumption: An ADF Web Application with ADF Desktop Integration enabled workbook having Employee form as in below screenshot is readily available

Form_DT.PNG
Now, Our goal is to make the InputText component bound to Hiredate as Date-Picker

We can achieve this either by using Microsoft's ActiveX Calendar Control components or by building our own calendar component using macros.

The disadvantage of using Microsoft's ActiveX Calendar Control component is that we need to  register MSCAL.OCX or MSCOMCT2.OCX with every machine we are going to access this workbook and in real-time it would be difficult to maintain the control everywhere.

Here, I discuss the second approach and for which I made use of the macro code given by VBA Express to build calendar.

Procedure

-  Open Microsoft Visual Basic Editor by clicking on 'View Code' button under 'Developer' Tab

-  Insert a new user form using Insert -> UserForm option and change the name of the form as CalendarFrm

Insert_Form.png

- Design the form as in below screenshot and name First two combo boxes as CB_Mth and CB_Yr, Sun to Sat from Label2 to Label8 and remaining Day cells from D1 to D42 (Easiest way of designing the form is to download the workbook attached at the end and copy the form to your excel workbook so that the layout and names everything gets copied)

Calendar_Form.png
- Right click on the Form in Project Explorer and choose ViewCode option

Calendar_Form_ViewCode.png
- Copy below code to form to add calendar functionality

Option Explicit
Dim ThisDay As Date
Dim ThisYear, ThisMth As Date
Dim CreateCal As Boolean
Dim i As Integer

Private Sub UserForm_Initialize()
    Application.EnableEvents = False
     'starts the form on todays date
    ThisDay = Date
    
    ThisMth = Format(ThisDay, "mm")
    ThisYear = Format(ThisDay, "yyyy")
    For i = 1 To 12
        CB_Mth.AddItem Format(DateSerial(Year(Date), Month(Date) + i, 0), "mmmm")
    Next
    CB_Mth.ListIndex = Format(Date, "mm") - Format(Date, "mm")
    For i = -20 To 50
        If i = 1 Then CB_Yr.AddItem Format((ThisDay), "yyyy") Else CB_Yr.AddItem _
        Format((DateAdd("yyyy", (i - 1), ThisDay)), "yyyy")
    Next
    CB_Yr.ListIndex = 21
     'Builds the calendar with todays date
    CreateCal = True
    Call Build_Calendar
    Application.EnableEvents = True
End Sub

Private Sub CB_Mth_Change()
     'rebuilds the calendar when the month is changed by the user
    Build_Calendar
End Sub
Private Sub CB_Yr_Change()
     'rebuilds the calendar when the year is changed by the user
    Build_Calendar
End Sub
Private Sub Build_Calendar()
     'the routine that actually builds the calendar each time
    If CreateCal = True Then
        CalendarFrm.Caption = " " & CB_Mth.Value & " " & CB_Yr.Value
        For i = 1 To 42
            If i < Weekday((CB_Mth.Value) & "/1/" & (CB_Yr.Value)) Then
                Controls("D" & (i)).Caption = Format(DateAdd("d", (i - Weekday((CB_Mth.Value) & "/1/" & (CB_Yr.Value))), _
                ((CB_Mth.Value) & "/1/" & (CB_Yr.Value))), "d")
                Controls("D" & (i)).ControlTipText = Format(DateAdd("d", (i - Weekday((CB_Mth.Value) & "/1/" & (CB_Yr.Value))), _
                ((CB_Mth.Value) & "/1/" & (CB_Yr.Value))), "m/d/yy")
            ElseIf i >= Weekday((CB_Mth.Value) & "/1/" & (CB_Yr.Value)) Then
                Controls("D" & (i)).Caption = Format(DateAdd("d", (i - Weekday((CB_Mth.Value) _
                & "/1/" & (CB_Yr.Value))), ((CB_Mth.Value) & "/1/" & (CB_Yr.Value))), "d")
                Controls("D" & (i)).ControlTipText = Format(DateAdd("d", (i - Weekday((CB_Mth.Value) & "/1/" & (CB_Yr.Value))), _
                ((CB_Mth.Value) & "/1/" & (CB_Yr.Value))), "m/d/yy")
            End If
            If Format(DateAdd("d", (i - Weekday((CB_Mth.Value) & "/1/" & (CB_Yr.Value))), _
            ((CB_Mth.Value) & "/1/" & (CB_Yr.Value))), "mmmm") = ((CB_Mth.Value)) Then
                If Controls("D" & (i)).BackColor <> &H80000016 Then Controls("D" & (i)).BackColor = &H80000018 '&H80000010
                Controls("D" & (i)).Font.Bold = True
                If Format(DateAdd("d", (i - Weekday((CB_Mth.Value) & "/1/" & (CB_Yr.Value))), _
                ((CB_Mth.Value) & "/1/" & (CB_Yr.Value))), "m/d/yy") = Format(ThisDay, "m/d/yy") Then Controls("D" & (i)).SetFocus
            Else
                If Controls("D" & (i)).BackColor <> &H80000016 Then Controls("D" & (i)).BackColor = &H8000000F
                Controls("D" & (i)).Font.Bold = False
            End If
        Next
    End If
End Sub
Private Sub D1_Click()
     'this sub and the ones following represent the buttons for days on the form
     'retrieves the current value of the individual controltiptext and
     'places it in the active cell
    ActiveCell.Value = D1.ControlTipText
    Unload Me
     'after unload you can call a different userform to continue data entry
     'uncomment this line and add a userform named UserForm2
     'Userform2.Show
     
End Sub
Private Sub D2_Click()
    ActiveCell.Value = D2.ControlTipText
    Unload Me
     
End Sub
Private Sub D3_Click()
    ActiveCell.Value = D3.ControlTipText
    Unload Me
     
End Sub
Private Sub D4_Click()
    ActiveCell.Value = D4.ControlTipText
    Unload Me
     
End Sub
Private Sub D5_Click()
    ActiveCell.Value = D5.ControlTipText
    Unload Me
     
End Sub
Private Sub D6_Click()
    ActiveCell.Value = D6.ControlTipText
    Unload Me
     
End Sub
Private Sub D7_Click()
    ActiveCell.Value = D7.ControlTipText
    Unload Me
     
End Sub
Private Sub D8_Click()
    ActiveCell.Value = D8.ControlTipText
    Unload Me
     
End Sub
Private Sub D9_Click()
    ActiveCell.Value = D9.ControlTipText
    Unload Me
     
End Sub
Private Sub D10_Click()
    ActiveCell.Value = D10.ControlTipText
    Unload Me
     
End Sub
Private Sub D11_Click()
    ActiveCell.Value = D11.ControlTipText
    Unload Me
     
End Sub
Private Sub D12_Click()
    ActiveCell.Value = D12.ControlTipText
    Unload Me
     
End Sub
Private Sub D13_Click()
    ActiveCell.Value = D13.ControlTipText
    Unload Me
     
End Sub
Private Sub D14_Click()
    ActiveCell.Value = D14.ControlTipText
    Unload Me
     
End Sub
Private Sub D15_Click()
    ActiveCell.Value = D15.ControlTipText
    Unload Me
     
End Sub
Private Sub D16_Click()
    ActiveCell.Value = D16.ControlTipText
    Unload Me
     
End Sub
Private Sub D17_Click()
    ActiveCell.Value = D17.ControlTipText
    Unload Me
     
End Sub
Private Sub D18_Click()
    ActiveCell.Value = D18.ControlTipText
    Unload Me
     
End Sub
Private Sub D19_Click()
    ActiveCell.Value = D19.ControlTipText
    Unload Me
     
End Sub
Private Sub D20_Click()
    ActiveCell.Value = D20.ControlTipText
    Unload Me
     
End Sub
Private Sub D21_Click()
    ActiveCell.Value = D21.ControlTipText
    Unload Me
     
End Sub
Private Sub D22_Click()
    ActiveCell.Value = D22.ControlTipText
    Unload Me
     
End Sub
Private Sub D23_Click()
    ActiveCell.Value = D23.ControlTipText
    Unload Me
     
End Sub
Private Sub D24_Click()
    ActiveCell.Value = D24.ControlTipText
    Unload Me
     
End Sub
Private Sub D25_Click()
    ActiveCell.Value = D25.ControlTipText
    Unload Me
     
End Sub
Private Sub D26_Click()
    ActiveCell.Value = D26.ControlTipText
    Unload Me
     
End Sub
Private Sub D27_Click()
    ActiveCell.Value = D27.ControlTipText
    Unload Me
     
End Sub
Private Sub D28_Click()
    ActiveCell.Value = D28.ControlTipText
    Unload Me
     
End Sub
Private Sub D29_Click()
    ActiveCell.Value = D29.ControlTipText
    Unload Me
     
End Sub
Private Sub D30_Click()
    ActiveCell.Value = D30.ControlTipText
    Unload Me
     
End Sub
Private Sub D31_Click()
    ActiveCell.Value = D31.ControlTipText
    Unload Me
     
End Sub
Private Sub D32_Click()
    ActiveCell.Value = D32.ControlTipText
    Unload Me
     
End Sub
Private Sub D33_Click()
    ActiveCell.Value = D33.ControlTipText
    Unload Me
     
End Sub
Private Sub D34_Click()
    ActiveCell.Value = D34.ControlTipText
    Unload Me
     
End Sub
Private Sub D35_Click()
    ActiveCell.Value = D35.ControlTipText
    Unload Me
     
End Sub
Private Sub D36_Click()
    ActiveCell.Value = D36.ControlTipText
    Unload Me
     
End Sub
Private Sub D37_Click()
    ActiveCell.Value = D37.ControlTipText
    Unload Me
     
End Sub
Private Sub D38_Click()
    ActiveCell.Value = D38.ControlTipText
    Unload Me
     
End Sub
Private Sub D39_Click()
    ActiveCell.Value = D39.ControlTipText
    Unload Me
     
End Sub
Private Sub D40_Click()
    ActiveCell.Value = D40.ControlTipText
    Unload Me
     
End Sub
Private Sub D41_Click()
    ActiveCell.Value = D41.ControlTipText
    Unload Me
     
End Sub
Private Sub D42_Click()
    ActiveCell.Value = D42.ControlTipText
    Unload Me
     
End Sub
Please note that this step doesn't have anything specific to ADF Desktop Integration it is purely excel macro so not explaining much on the code part

- Finally, add below code to the Worksheet _BeforeDoubleClick event of the sheet having employee form to invoke Calendar on double-clicking on Hiredate

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
        ' $D$7 is the cell containing Hiredate
        If ActiveCell.Address = "$D$7" Then
            CalendarFrm.Show
        End If
End Sub
- Save the changes and Run the design time of workbook

Run_DT.png
- Navigate to first record, double-click on Hiredate field and notice date-picker dialog and date selected will be shown back to Hiredate field


Form_Calendar_RT.png


Sample design-time workbook developed in 11.1.2.0.0 can be downloaded Here (Right-Click on the link and choose "Save Link As..." option to download the workbook)


Comments:

Thanks a lot for this blog. I tried to download "Simulating Date Picker in ADF Desktop Integration " sample but can't. can you help to me.

Regards

Posted by guest on February 16, 2012 at 01:32 PM IST #

Hi,

Right Click on the download link and choose "Save Link As..." option from the context menu to download the workbook.

Thanks,
Sireesha

Posted by Sireesha on February 16, 2012 at 04:27 PM IST #

Hi there. I just ran accross your information here and it's clearly explaining what I am trying to do. I have been unable to find understandable instructions for this anywhere else and I am still a newbie to vba.

I noticed the link at the bottom to download the form you created, but it goes to a blank page. Is there somewhere else I can find your form or am I out of luck.

Any info you can provide would be greatly appreciated. Thank you.

Posted by guest on March 08, 2012 at 03:13 AM IST #

Hi,

I have updated the link, please try it now and make sure you use "Save Link As.." option from the context menu to download the excel workbook.

Thanks,
Sireesha

Posted by Sireesha on March 08, 2012 at 12:25 PM IST #

Thank you very much for your precious information.I"m not VBA programmer but can used under your instruction.If you don't mind can you show to me how to add a time. e.g 15/03/2012 08:12 AM

Regards
KT

Posted by guest on March 20, 2012 at 07:31 AM IST #

Post a Comment:
  • HTML Syntax: NOT allowed
About

Tips and Tricks from Oracle's JDeveloper & ADF QA

Search

Archives
« April 2014
SunMonTueWedThuFriSat
  
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
   
       
Today