Calendar control

[KellyJo]

Man, am I stuck! I have no coding skills and I'm afraid that I won't be able to figure this problem out.

I have a form that I want to use to enter employee schedules on biweekly. I select the employee from a combo box and I want to be able to click on multiple dates in the active x calendar 9.0 and have each date be stored in the correct field. The order would be the same every time. any ideas? I'm SO stuck.

KellyJo

 

[hneal98]

You can not select multiple dates from a single control. Only one date at a time can be selected. That means you would have to have the calendar pop up once for each date needed.

 

[fneily]

Unfortunately, Tek-tips dosn't allow me to post my email so I can't have you send me yours so I can send you this example. I'll try to explain this method.
I just finished a project that has around 50 date fields. So I just have the user double click the needed date field textbox, then pick a date off a calendar that populates the textbox to be stored. Here's the steps:

Create a form 2 inches square. You will create label boxes on it, most will be .1667 inches square. Across the top, place 5 labels. The first caption will be <<, the second <, the third will say Date, the fourth will have >, and the fifth will have >>. You can see the names of these labels from the code below.
You will then create seven labels with captions S, M, T, W, T, F, S. Then you will create 42 labels all with caption 0, Names lab1 to lab42.
Then at the bottom, you will have two boxes that say Today and Cancel.

In a Module in VBA, create the global variable:
Public ctlIn As Control

On your Form, open VBA(Alt + F11) and put the following in the Declartions section:
Option Compare Database
Dim datArg As Date ' Default date passed to frmCalendar

On the textbox control's Double Click event, put:
Set ctlIn = Me.ActiveControl ' Get global variable to active control
DoCmd.OpenForm "frmCalendar"

Copy the rest of this code below the Double click event:
Private Sub Form_Load()
If IsDate(ctlIn) Then ' If control already contains a date...
datArg = ctlIn ' ... use that to start
Else
datArg = Date ' ...otherwise start at today's date
End If
labDat.Caption = Format(datArg, "mmmm yyyy") ' Set frmCalendar's MMMM YYYY banner
fctnPopulate ' Function to set and format the calendar grid
End Sub

Private Function fctnDate_Click(ctl As Control)
' Called by clicking any date on the calendar grid
Dim datOut As Date ' Date variable to be retained after frmCalendar is closed
If ctl.ForeColor = 0 Then ' In the currently displayed month, i.e. date not greyed out
datOut = CDate(ctl.Caption & " " & labDat.Caption) ' Set datOut
Else
If CInt(Mid$(ctl.Name, 4)) < 8 Then ' Tail-end of the previous month
datOut = CDate(ctl.Caption & " " & Format(CDate(Format(labDat.Caption, "dd-mmm-yyyy")) - 1, "mmmm yyyy")) ' Set datOut
Else ' Start of the next month
datOut = CDate(ctl.Caption & " " & Format(CDate(Format(labDat.Caption, "dd-mmm-yyyy")) + 31, "mmmm yyyy")) ' Set datOut
End If
End If

DoCmd.Close acForm, "frmCalendar", acSaveNo ' Close frmCalendar first, as it's modal
ctlIn = datOut
End Function

Private Function fctnPopulate()
' Populate and format the calendar labels grid
Dim datIn As Date ' Date variable to be set as the first day of the displayed month
Dim bytLab As Byte ' Byte variable to be set as the day of the week the first of the month is on
Dim ctl As Control ' Control object allows calendar grid controls to be looped through
Dim strLab As String ' String variable used to isolate the numeric portion of a calendar grid control's name
Dim datOut As Date ' Date variable set and written out to the calendar grid controls
datIn = Format(labDat.Caption, "dd-mmm-yyyy") ' Set to the first of the displayed month
bytLab = Weekday(datIn, vbSunday) ' Determine which day of the week the first of the month is on
For Each ctl In Me.Controls ' Loop through all the controls on the form
If ctl.Tag = 1 Then ' All 42 of the calendar grid date labels have a Tag value of 1
strLab = Mid$(ctl.Name, 4) ' Works out with date label is being used, i.e. control lab35 returns strLab="35"
datOut = datIn + (CInt(strLab) - bytLab) ' Use datIn and offset from first day of the month control to set value of datOut
ctl.Caption = Format(datOut, "dd") ' Set the control's caption to the date portion of datOut
ctl.BorderStyle = -1 * (datOut = Date) 'If today's date then border in red
ctl.BackColor = 16777215 + (4144959 * (datOut = datArg)) ' Background is grey if default date, otherwise white
If Left$(ctl.Caption, 1) = "0" Then ctl.Caption = Mid$(ctl.Caption, 2) ' Remove leading zeros, so 01 becomes 1
If Format(datIn, "mm") = Format(datOut, "mm") Then ' If control's date value is in the displayed month
ctl.ForeColor = 0 ' Text is black
Else ' Tail-end of previous month or beginning of next
ctl.ForeColor = 8421504 ' Text is dark grey
End If
End If
Next ctl ' Do the loop
End Function

Private Sub labCancel_Click()
DoCmd.Close ' Close frmCalendar
End Sub

Private Sub labMthAdd_Click()
labDat.Caption = Format(CDate(Format(labDat.Caption, "dd-mmm-yyyy")) + 31, "mmmm yyyy") ' Re-banner the form with next month
fctnPopulate ' Function to set and format the calendar grid
End Sub

Private Sub labMthSub_Click()
labDat.Caption = Format(CDate(Format(labDat.Caption, "dd-mmm-yyyy")) - 1, "mmmm yyyy") ' Re-banner the form with previous month
fctnPopulate ' Function to set and format the calendar grid
End Sub

Private Sub labToday_Click()
labDat.Caption = Format(Date, "mmmm yyyy") ' Re-banner the form with the current month
fctnPopulate ' Function to set and format the calendar grid
End Sub

Private Sub labYrAdd_Click()
labDat.Caption = Format(CDate(Format(labDat.Caption, "dd-mmm-yyyy")) + 366, "mmmm yyyy") ' Re-banner the form with this month next year
fctnPopulate ' Function to set and format the calendar grid
End Sub

Private Sub labYrSub_Click()
labDat.Caption = Format(CDate(Format(labDat.Caption, "dd-mmm-yyyy")) - 365, "mmmm yyyy") ' Re-banner the form with this month last year
fctnPopulate ' Function to set and format the calendar grid
End Sub