code below
Option Compare Database
Option Explicit
Private Sub Form_DblClick(Cancel As Integer)
'======================================================
'
' By Michael R. McCullough
' Global Research and Development
' Extension 6454
'
' (c) 2000 by Mary Kay Holding Corp.
' All rights reserved.
'
'=======================================================
On Error GoTo Err_Form_DblClick
Dim FormName As String
Dim SyncCriteria As String
Dim varArgs As Variant
' If the hidden FragranceCounter on the subform
' is blank, then exit this Sub.
If IsNull(Me![txt_FragranceCounter]) Then
GoTo Exit_Form_DblClick
End If
' Set the formname to the form that will be
' synchronized.
FormName = "frm_PRMs"
' Establish an Open Argument named PRM and place
' into it the hidden PRM Counter. This will be
' retrieved by the called form and will set the open
' record to the correct Fragrance Counter field.
varArgs = adhPutItem(varArgs, "PRM", fld_PRMCounter)
' Check to see if the PRM form
' is open. If it is not open, then open it.
If Not SysCmd(acSysCmdGetObjectState, acForm, FormName) Then
Call glrChainForm(Forms![frm_Fragrances], FormName, , , , varArgs)
End If
Exit_Form_DblClick:
Exit Sub
Err_Form_DblClick:
MsgBox Err.Description
Resume Exit_Form_DblClick
End Sub
Private Sub Form_Error(DataErr As Integer, Response As Integer)
'======================================================
'
' By Michael R. McCullough
' Global Research and Development
' Extension 6454
'
' (c) 2000 by Mary Kay Holding Corp.
' All rights reserved.
'
'=======================================================
On Error GoTo Err_Form_Error:
' This calls a general error-handling routine
sfeFormErrorHandler DataErr, Response, Me
Exit_Form_Error:
Exit Sub
Err_Form_Error:
MsgBox Err.Description
Resume Exit_Form_Error
End Sub
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
'======================================================
'
' By Michael R. McCullough
' Global Research and Development
' Extension 6454
'
' (c) 2000 by Mary Kay Holding Corp.
' All rights reserved.
'
'=======================================================
' Traps the up and down arrows to move around vertically
' kind of like a spreadsheet. Also traps the tab, shift-tab,
' and return keys.
On Error GoTo Form_KeyDown_Err
Dim recordnum As Long
Dim intShiftDown As Boolean
Dim ctlCurrent As Control
' Set an error constant to handle error that pops up
' regarding the current control when trying to delete
' a record
Const mkNotActiveWindow = 2474
' Find out where the current record is, set a
' shift variable, and set the current control
recordnum = Me.CurrentRecord
intShiftDown = (Shift And SHIFT_MASK) > 0
Set ctlCurrent = Screen.ActiveControl
Select Case KeyCode
Case vbKeyDown
DoCmd.GoToRecord record:=acNext
KeyCode = 0
Case vbKeyUp
DoCmd.GoToRecord record:=acPrevious
KeyCode = 0
Case vbKeyTab
If recordnum = 1 Then ' Check if we're on first record
If intShiftDown Then ' Check if Shift Key is pressed
' Finally, see if we are on the the first field
If ctlCurrent.Name = "cmb_PRM" Then
Me.Parent!txt_VendorName.SetFocus
KeyCode = 0
End If
End If
End If
If NewRecordMark(Me) Then ' Check if we're on a new record
If intShiftDown Then ' Check if Shift Key is pressed
' Do nothing
Else
' See if we are on the the last field and that it is blank
If Not Me.Dirty Then
If ctlCurrent.Name = "txt_MaxPercentPRM" Then
Me.Parent!txt_FragranceNumber.SetFocus
KeyCode = 0
Else
' Do nothing
End If
End If
End If
End If
Case vbKeyReturn
If NewRecordMark(Me) Then ' Check if we're on a new record
If ctlCurrent.Name = "txt_MaxPercentPRM" Then
Me.Parent!txt_FragranceNumber.SetFocus
KeyCode = 0
Else
' Do nothing
End If
End If
Case Else
' Do nothing at all
End Select
Form_Keydown_Exit:
Exit Sub
Form_KeyDown_Err:
Select Case Err.Number
Case mkErrInvalidRow
KeyCode = 0
Case Else
MsgBox "Error: " & Err.Description & _
" (" & Err.Number & ")"
End Select
Resume Form_Keydown_Exit
End Sub
Private Sub txt_MaxPercentPRM_AfterUpdate()
On Error GoTo Err_fld_MaxPercentPRM_AfterUpdate
If Not IsNull([fld_MaxPercentPRM]) Then
If IsNull(txt_Added) Then
txt_WhoAdd = Format(mkGetUser(), "<")
txt_Added = Now()
Else
If Not NewRecordMark(Me) Then ' Check if we're on a new record
Forms![frm_Fragrances]![txt_WhoEdit] = Format(mkGetUser(), "<")
Forms![frm_Fragrances]![txt_Edited] = Now()
End If
End If
End If
Exit_fld_MaxPercentPRM_AfterUpdate:
Exit Sub
Err_fld_MaxPercentPRM_AfterUpdate:
MsgBox Err.Description
Resume Exit_fld_MaxPercentPRM_AfterUpdate
End Sub
Private Sub txt_MinPercentPRM_AfterUpdate()
On Error GoTo Err_fld_MinPercentPRM_AfterUpdate
If Not IsNull([fld_MaxPercentPRM]) Then
If IsNull(txt_Added) Then
txt_WhoAdd = Format(mkGetUser(), "<")
txt_Added = Now()
Else
If Not NewRecordMark(Me) Then ' Check if we're on a new record
Forms![frm_Fragrances]![txt_WhoEdit] = Format(mkGetUser(), "<")
Forms![frm_Fragrances]![txt_Edited] = Now()
End If
End If
End If
Exit_fld_MinPercentPRM_AfterUpdate:
Exit Sub
Err_fld_MinPercentPRM_AfterUpdate:
MsgBox Err.Description
Resume Exit_fld_MinPercentPRM_AfterUpdate
End Sub
Private Sub cmb_PRM_AfterUpdate()
'======================================================
'
' By Michael R. McCullough
' Global Research and Development
' Extension 6454
'
' (c) 2000 by Mary Kay Holding Corp.
' All rights reserved.
'
'=======================================================
On Error GoTo Err_cmb_PRM_AfterUpdate
If Not IsNull([cmb_PRM]) Then
If IsNull(txt_Added) Then
txt_WhoAdd = Format(mkGetUser(), "<")
txt_Added = Now()
Else
If Not NewRecordMark(Me) Then ' Check if we're on a new record
Forms![frm_Fragrances]![txt_WhoEdit] = Format(mkGetUser(), "<")
Forms![frm_Fragrances]![txt_Edited] = Now()
End If
End If
End If
Exit_cmb_PRM_AfterUpdate:
Exit Sub
Err_cmb_PRM_AfterUpdate:
MsgBox Err.Description
Resume Exit_cmb_PRM_AfterUpdate
End Sub
Private Sub cmb_PRM_Click()
'======================================================
'
' By Michael R. McCullough
' Global Research and Development
' Extension 6454
'
' (c) 2000 by Mary Kay Holding Corp.
' All rights reserved.
'
'=======================================================
On Error GoTo Err_cmb_PRM_Click
If IsNull(fld_PRM) Then
With Me![cmb_PRM]
.SelStart = 0
.SelLength = 0
.Requery
End With
End If
Exit_cmb_PRM_Click:
Exit Sub
Err_cmb_PRM_Click:
MsgBox Err.Description
Resume Exit_cmb_PRM_Click
End Sub
Private Sub cmb_PRM_GotFocus()
'======================================================
'
' By Michael R. McCullough
' Global Research and Development
' Extension 6454
'
' (c) 2000 by Mary Kay Holding Corp.
' All rights reserved.
'
'=======================================================
On Error GoTo Err_cmb_PRM_GotFocus
If IsNull(fld_PRM) Then
With Me![cmb_PRM]
.SelStart = 0
.SelLength = 0
.Requery
MsgBox "Howdy"
End With
End If
Exit_cmb_PRM_GotFocus:
Exit Sub
Err_cmb_PRM_GotFocus:
MsgBox Err.Description
Resume Exit_cmb_PRM_GotFocus
End Sub
Private Sub cmb_PRM_NotInList(NewData As String, Response As Integer)
'======================================================
'
' By Michael R. McCullough
' Global Research and Development
' Extension 6454
'
' (c) 2000 by Mary Kay Holding Corp.
' All rights reserved.
'
'=======================================================
On Error GoTo Err_cmb_PRM_GotFocus
If Not IsNull(DLookup("fld_PRM", "qry_PRMComboList", _
"fld_PRM=""" & NewData & """")) Then
Response = acDataErrAdded
Exit Sub
End If
If MsgBox("""" & NewData & """ is not in the PRM list. " & _
"Do you wish to add it?", 33) <> 1 Then
Response = acDataErrContinue
Exit Sub
End If
Call glrChainForm(Forms![frm_Fragrances], "frm_PRMsAdd", , , acFormAdd)
With Forms!frm_PRMsAdd
.txt_PRM.SetFocus
.txt_PRM = NewData
End With
Response = acDataErrContinue
Exit_cmb_PRM_GotFocus:
Exit Sub
Err_cmb_PRM_GotFocus:
MsgBox Err.Description
Resume Exit_cmb_PRM_GotFocus
End Sub
