I am using:
MS-ACCESS 2002 SP1
I need to populate a bounded control (SaleDateTime) using the following unbounded controls: txtFrom and txtTime, this after the txtTime control has been populate or changed by the user. I have tried using the afterupate, on change but with no luck. How can I get it to work, with a special note that I would also need to do this for another 5 controls that are in this form?
The txtFrom and txtTime are populated using forms frmReturnDateSmall and frmReturnTime. These popup when the user clicks on the command buttons called: cmdFrom and cmdTime.
All of the previous (except for the ReturnDate and ReturnTime forms) on a form called frmSale.
Sorry for the long post!
The code being used is the following, it was written by Jim Lunde:
cmdFrom =
cmdTime
There is a module called modReturnDateTime which holds the declaration of the functions, here is the code:
The form frmReturnDateSmall has the following code in it:
And the form frmReturnTime has the following code:
MS-ACCESS 2002 SP1
I need to populate a bounded control (SaleDateTime) using the following unbounded controls: txtFrom and txtTime, this after the txtTime control has been populate or changed by the user. I have tried using the afterupate, on change but with no luck. How can I get it to work, with a special note that I would also need to do this for another 5 controls that are in this form?
The txtFrom and txtTime are populated using forms frmReturnDateSmall and frmReturnTime. These popup when the user clicks on the command buttons called: cmdFrom and cmdTime.
All of the previous (except for the ReturnDate and ReturnTime forms) on a form called frmSale.
Sorry for the long post!
The code being used is the following, it was written by Jim Lunde:
cmdFrom =
Code:
Me.txtFrom = ReturnDate(SMALL,
Me.txtFrom)
cmdTime
Code:
Me.txtTime = ReturnTime(Nz(Me.txtTime, ""))
There is a module called modReturnDateTime which holds the declaration of the functions, here is the code:
Code:
Option Compare Database
Option Explicit
' Public Booleans
Public pCancel As Boolean
' Public Integers
Public pintDefaultMonth As Integer
Public pintDefaultYear As Integer
' Private Integers
Private mintDay As Integer
Private mintMonth As Integer
Private mintYear As Integer
Private mintOffset As Integer
' Public Strings
Public pstrReturnDate As String
Public pstrTime As String
' Public Constants
Public Const LARGE As Integer = 0
Public Const SMALL As Integer = 1
' Use the constants above or integers for the form size, not a string
Public Function ReturnDate(intFormSize As Integer, Optional datInputValue As Variant = "", Optional intMonthsFromCurrent As Integer = 0) As String
If IsDate(datInputValue) Or Nz(datInputValue) = "" Then
Dim varDefaultDate
Call ClearVariables
' Determine whether or not a date has been passed in, then set appropriate variables
If Nz(datInputValue) = "" Then
pstrReturnDate = ""
varDefaultDate = DateAdd("m", intMonthsFromCurrent, Date)
pintDefaultMonth = month(varDefaultDate)
pintDefaultYear = Year(varDefaultDate)
Else
pstrReturnDate = datInputValue
mintDay = Day(datInputValue)
pintDefaultMonth = month(datInputValue)
pintDefaultYear = Year(datInputValue)
End If
' Open the appropriate form based on the selection of the developer, either LARGE or SMALL
If intFormSize = 0 Then
DoCmd.OpenForm "frmReturnDateLarge", acNormal, , , , acDialog
ElseIf intFormSize = 1 Then
DoCmd.OpenForm "frmReturnDateSmall", acNormal, , , , acDialog
End If
' Clear the variables and send back the date the user selected
Call ClearVariables
ReturnDate = pstrReturnDate
Else
MsgBox "The date you have entered is invalid," & vbNewLine & vbNewLine & "Please verify the date, and try again", vbExclamation, " Invalid Date"
End If
End Function
Public Sub PopulateCalender(ByVal intMo As Integer, ByVal intYr As Integer, strForm As String)
Dim i As Integer, X As Integer
Dim datDayOne As Date
Dim frm As Form
Dim strDate As String
Dim strFixedDate As String
' Set variables
Set frm = Forms(strForm)
intMo = frm!month: mintMonth = frm!month
intYr = frm!Year: mintYear = frm!Year
' Hide all text boxes
For i = 1 To 37
frm("txt" & i).Visible = False
frm("txt" & i).ForeColor = vbBlack
frm("txt" & i).FontBold = False
Next
'This fixed was developed due to incorrect date presentation
strFixedDate = "01" & "/" & Mid(CStr(intMo + 100), 2, 2) & "/" & intYr
datDayOne = DateValue(strFixedDate)
'datDayOne = DateValue(intMo & "/01/" & intYr)
mintOffset = WeekDay(datDayOne) - 1
' Show the label for the selected month
frm!lblMonthYear.Caption = Format(strFixedDate, "MMMM YYYY")
' Show all valid dates for selected month
X = Day(Date)
For i = 1 To GetLenMonth(datDayOne)
frm("txt" & i + mintOffset).Visible = True
frm("txt" & i + mintOffset) = i
frm("txt" & 1 + mintOffset).Tag = i
' Make the current date Red
If frm!month = month(Date) And frm!Year = CStr(Year(Date)) Then
If i = X Then
frm("txt" & i + mintOffset).ForeColor = 16711680 '16711680
End If
Else
frm("txt" & i + mintOffset).ForeColor = vbBlack
End If
' If a date was passed in, make it sunken
If frm!month = pintDefaultMonth And frm!Year = pintDefaultYear Then
If i = mintDay Then
frm("txt" & i + mintOffset).SpecialEffect = acEffectSunken
Else
frm("txt" & i + mintOffset).SpecialEffect = 0
End If
Else
frm("txt" & i + mintOffset).SpecialEffect = 0
End If
Next
End Sub
Private Function GetLenMonth(datDate As Date)
Dim datStart As Date
Dim datFinish As Date
' Simply gets the length of a given month
datStart = DateValue(month(datDate) & "/1/" & Year(datDate))
datFinish = DateAdd("m", 1, datStart)
GetLenMonth = datFinish - datStart
End Function
Public Function SetDate(intNum)
Dim strDate As String
' Create the the public date based on the selection of the user.
' Call comes from the On Click of each day on the calendar forms
strDate = mintMonth & "/" & (intNum - mintOffset) & "/" & mintYear
'If IsLoaded("frmReturnDateLarge") Then DoCmd.Close acForm, "frmReturnDateLarge"
If IsLoaded("frmReturnDateSmall") Then DoCmd.Close acForm, "frmReturnDateSmall"
pstrReturnDate = Format(CDate(strDate), "mm/dd/yyyy")
End Function
Private Sub ClearVariables()
' Used to clear all module and public level variables
pintDefaultMonth = 0
pintDefaultYear = 0
mintDay = 0
mintMonth = 0
mintYear = 0
mintOffset = 0
End Sub
Public Function ReturnTime(Optional strTime As String = "") As String
' If no time was passed in
If strTime = "" Then
pstrTime = Format(Now(), "h:mm AM/PM")
' If there Was a time passed in
Else
pstrTime = strTime
End If
DoCmd.OpenForm "frmReturnTime", , , , , acDialog
' If user cancels, do nothing
If pCancel Then
If strTime = "" Then
ReturnTime = ""
Else
ReturnTime = strTime
End If
' Else populate public variable
Else
ReturnTime = pstrTime
End If
pCancel = False
End Function
Function IsLoaded(ByVal strFormName As String) As Boolean
'Purpose: Determines if a given form is loaded
'If IsLoaded("FormName") then ...
Const conObjStateClosed = 0
Const conDesignView = 0
If SysCmd(acSysCmdGetObjectState, acForm, strFormName) <> conObjStateClosed Then
If Forms(strFormName).CurrentView <> conDesignView Then
IsLoaded = True
End If
End If
End Function
The form frmReturnDateSmall has the following code in it:
Code:
Option Compare Database
Option Explicit
Private Sub Form_Close()
Screen.MousePointer = 0 ' Default
End Sub
Private Sub Form_Load()
Dim i As Integer
For i = 1 To 37
Me("txt" & i).Visible = False
Next
Me!month = pintDefaultMonth
Me!Year = pintDefaultYear
Call PopulateCalender([month], [Year], Me.NAME)
Call mSetYears("None", True)
End Sub
Private Sub Form_Open(Cancel As Integer)
Screen.MousePointer = 1 ' Arrow
Me.txtHolder.SetFocus
End Sub
Private Sub lblYear1_Click()
Call mDoYears(Me.lblYear1.Caption)
End Sub
Private Sub lblYear2_Click()
Call mDoYears(Me.lblYear2.Caption)
End Sub
Private Sub lblYear3_Click()
Call mDoYears(Me.lblYear3.Caption)
End Sub
Private Sub lblYear4_Click()
Call mDoYears(Me.lblYear4.Caption)
End Sub
Private Sub lblYear5_Click()
Call mDoYears(Me.lblYear5.Caption)
End Sub
Private Sub Year_Change()
Call PopulateCalender([month], [Year], Me.NAME)
End Sub
Private Function mHighlightMoYr(ctlChange As Control)
Dim ctl As Control
For Each ctl In Me
If TypeOf ctl Is Label Then
If ctl.NAME <> "lblMonthYear" Then
If ctl.NAME Like "lblDay*" Then
Else
ctl.ForeColor = 16711680
End If
End If
End If
Next ctl
If TypeOf ctlChange Is Label Then ctlChange.ForeColor = vbBlack
End Function
'Private Function mHighlightDay(ctlChange As Control)
' Dim ctl As Control
' For Each ctl In Me
' If TypeOf ctl Is TextBox Then
' ctl.SpecialEffect = 0
' End If
' Next ctl
' ctlChange.BackStyle = 1
' ctlChange.SpecialEffect = 5
'End Function
Private Function mDoMonths(intMo As Integer, bDoCalender As Boolean)
Dim i As Integer
Me!month = intMo
For i = 1 To 12
If i = intMo Then
Me("lblMo" & i).FontBold = True
Else
Me("lblMo" & i).FontBold = False
End If
Next i
If bDoCalender Then
Call PopulateCalender([month], [Year], Me.NAME)
End If
End Function
Private Sub mDoYears(intYr As Integer)
Me!Year = intYr
Call PopulateCalender([month], [Year], Me.NAME)
Call mSetYears("None", False, True)
End Sub
Private Function mSetYears(strDirection As String, bOpen As Boolean, Optional bSkip As Boolean = False)
Dim i As Integer
If bSkip Then GoTo SetYears_Skip
Select Case strDirection
Case "None"
Me.lblYear1.Caption = pintDefaultYear - 2
Me.lblYear2.Caption = pintDefaultYear - 1
Me.lblYear3.Caption = pintDefaultYear
Me.lblYear4.Caption = pintDefaultYear + 1
Me.lblYear5.Caption = pintDefaultYear + 2
Call mDoMonths(pintDefaultMonth, False)
Case "Next"
For i = 1 To 5
Me("lblYear" & i).Caption = Me("lblYear" & i).Caption + 1
Next i
Case "Previous"
For i = 1 To 5
Me("lblYear" & i).Caption = Me("lblYear" & i).Caption - 1
Next i
End Select
SetYears_Skip:
For i = 1 To 5
If bOpen Then
If Me("lblYear" & i).Caption = pintDefaultYear Then
Me("lblYear" & i).FontBold = True
Else
Me("lblYear" & i).FontBold = False
End If
Else
If Me("lblYear" & i).Caption = CInt(Me!Year) Then
Me("lblYear" & i).FontBold = True
Else
Me("lblYear" & i).FontBold = False
End If
End If
Next i
End Function
And the form frmReturnTime has the following code:
Code:
Option Compare Database
Option Explicit
Private Sub cmdCancel_Click()
pCancel = True
DoCmd.Close
End Sub
Private Sub cmdOK_Click()
pstrTime = Me.txtTime
DoCmd.Close
End Sub
Private Sub Form_Open(Cancel As Integer)
Dim strAMPM As String
Dim intHour As Integer
' pstrTime = Now()
Me.txtTime = Format(pstrTime, "h:nn AM/PM")
strAMPM = Format(pstrTime, "AM/PM")
intHour = Format(pstrTime, "h")
If intHour > 12 Then
intHour = intHour - 12
Else
intHour = Format(pstrTime, "h")
End If
Me.optHours = intHour
Me.optMinutes = Format(pstrTime, "n")
If strAMPM = "AM" Then
Me.optAMPM = 1
Else
Me.optAMPM = 2
End If
End Sub
Private Sub ChangeTime()
Me.txtTime = Me.optHours & ":" & IIf(Me.optMinutes < 10, "0" & Me.optMinutes, Me.optMinutes) & " " & IIf(Me.optAMPM = 1, "AM", "PM")
End Sub
Private Sub optAMPM_Click()
ChangeTime
End Sub
Private Sub optHours_Click()
ChangeTime
End Sub
Private Sub optMinutes_Click()
ChangeTime
End Sub