frmemployees_new.frm

英文版Access数据库编程

      Left            =   5160
      TabIndex        =   35
      Top             =   1440
      Width           =   855
   End
   Begin VB.Label Label1 
      Caption         =   "TFN:"
      Height          =   255
      Index           =   14
      Left            =   5160
      TabIndex        =   34
      Top             =   1800
      Width           =   855
   End
   Begin VB.Label Label1 
      Caption         =   "Position:"
      ForeColor       =   &H000000FF&
      Height          =   255
      Index           =   15
      Left            =   5160
      TabIndex        =   33
      Top             =   2160
      Width           =   855
   End
   Begin VB.Label Label1 
      Caption         =   "Salary:"
      ForeColor       =   &H000000FF&
      Height          =   255
      Index           =   16
      Left            =   5160
      TabIndex        =   32
      Top             =   2520
      Width           =   855
   End
   Begin VB.Label Label1 
      Caption         =   "Date of Comm:"
      ForeColor       =   &H000000FF&
      Height          =   255
      Index           =   17
      Left            =   5160
      TabIndex        =   31
      Top             =   2880
      Width           =   1095
   End
   Begin VB.Label Label2 
      Caption         =   "Married:"
      ForeColor       =   &H000000FF&
      Height          =   255
      Left            =   120
      TabIndex        =   30
      Top             =   2880
      Width           =   1335
   End
   Begin VB.Shape Shape1 
      BackColor       =   &H00FF8080&
      BackStyle       =   1  'Opaque
      BorderStyle     =   0  'Transparent
      Height          =   855
      Left            =   0
      Top             =   0
      Width           =   9015
   End
End
Attribute VB_Name = "frmEmployees_New"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private maxIncome As Single
Private Sub cmdSave_Click()
If isDateValid(CByte(ddBirth.Text), CByte(mmBirth.Text), CInt(yyyyBirth.Text)) = False Then
    ValidMsg "Please enter a valid date of birth.", "Invalid date"
    ddBirth.SetFocus
ElseIf isDateValid(CByte(ddComm.Text), CByte(mmComm.Text), CInt(yyyyComm.Text)) = False Then
    ValidMsg "Please enter a valid commencement date.", "Invalid date"
    ddComm.SetFocus
ElseIf ((CCur(txtSalary.Text) <= 0) Or (CCur(txtSalary.Text) > maxIncome)) Then
    ValidMsg "Please enter a salary between 0 and " & maxIncome & ".", "Invalid salary"
    txtSalary.SetFocus
Else
    Dim tempSQL As String
    'Obtain new ID
    tempSQL = "SELECT * FROM Misc WHERE Misc.DataType='EMP';"
    
    Screen.MousePointer = 11
    Dim newRS As Recordset, empRS As Recordset
    Dim newEmpID As Integer
    Set newRS = MySynonDatabase.OpenRecordset(tempSQL, dbOpenDynaset)
    newEmpID = CInt(newRS("DataValue"))
    'Insert new record
    tempSQL = "SELECT * FROM Employees;"
    Set empRS = MySynonDatabase.OpenRecordset(tempSQL, dbOpenDynaset, dbAppendOnly)
    
   'On Error GoTo ErrHandler
    empRS.AddNew
    empRS("EmployeeID") = "EMP" & Format$(newEmpID, "0000")
    empRS("Name") = txtName.Text
    If optMale.Value = True Then
        empRS("Gender") = False
    Else
        empRS("Gender") = True
    End If
    empRS("DOB") = ddBirth.Text & "/" & mmBirth.Text & "/" & yyyyBirth.Text
    empRS("IC") = txtIC.Text
    If optMarriedYes.Value = True Then
        empRS("Maritial") = True
        empRS("Children") = txtChildren.Text
    Else
        empRS("Maritial") = False
    End If
    empRS("Race") = cmbRace.Text
    empRS("Address") = txtAddress.Text
    empRS("CountryID") = cmbCountry.Text
    empRS("StateID") = cmbState.Text
    empRS("City") = cmbCity.Text
    empRS("Zip") = txtZip.Text
    empRS("EPF") = txtEPF.Text
    empRS("SSN") = txtSocso.Text
    empRS("TFN") = txtTFN.Text
    empRS("PositionID") = cmbPosition.Text
    empRS("Salary") = txtSalary.Text
    empRS("Commence") = ddComm.Text & "/" & mmComm.Text & "/" & yyyyComm.Text
    empRS("Notes") = IIf(IsNull(txtNotes.Text), "", txtNotes.Text)
    empRS.Update 'Save record
    
    empRS.Close
    'Increment the existing key ID
    newRS.Edit
    newRS("DataValue") = newEmpID + 1
    newRS.Update
    
    newRS.Close
    Set newRS = Nothing
    Set empRS = Nothing
    'Update the progress
    tempSQL = "INSERT INTO Progress VALUES ('EMP" & Format$(newEmpID, "0000") & "','" & Format$(Now(), "dd/mm/yyyy") & "','Joined the company.');"
    MySynonDatabase.Execute tempSQL
    'Inform user
    Screen.MousePointer = 0
    InfoMsg "Employee ID: EMP" & Format$(newEmpID, "0000") & vbCrLf & "New employee record has been successfully created.", "Record saved"
    frmEmployees.GetAllEmployees
    Unload Me
End If

ErrHandler:
If Err.Number <> 0 Then
    ErrorNotifier Err.Number, Err.description
    Exit Sub
End If
End Sub

Private Sub ddBirth_Click()
CheckEmpFields
End Sub

Private Sub ddBirth_GotFocus()
SelText ddBirth
End Sub

Private Sub ddBirth_KeyPress(KeyAscii As Integer)
OnlyNum KeyAscii
End Sub

Private Sub ddComm_GotFocus()
SelText ddComm
End Sub

Private Sub ddComm_KeyPress(KeyAscii As Integer)
OnlyNum KeyAscii
End Sub

Private Sub mmBirth_Click()
CheckEmpFields
End Sub

Private Sub mmComm_Click()
CheckEmpFields
End Sub

Private Sub mmComm_GotFocus()
SelText mmComm
End Sub

Private Sub mmComm_KeyPress(KeyAscii As Integer)
OnlyNum KeyAscii
End Sub

Private Sub txtAddress_KeyPress(KeyAscii As Integer)
tickerKeys KeyAscii
End Sub

Private Sub txtEPF_Change()
CheckEmpFields
End Sub

Private Sub txtEPF_GotFocus()
SelText txtEPF
End Sub

Private Sub txtIC_Change()
CheckEmpFields
End Sub

Private Sub txtIC_GotFocus()
SelText txtIC
End Sub

Private Sub txtIC_KeyPress(KeyAscii As Integer)
OnlyNum KeyAscii
End Sub

Private Sub txtName_Change()
CheckEmpFields
End Sub

Private Sub txtName_GotFocus()
SelText txtName
End Sub

Private Sub txtName_LostFocus()
CapCon txtName
End Sub

Private Sub txtNotes_Change()
CheckEmpFields
End Sub

Private Sub txtNotes_GotFocus()
SelText txtNotes
End Sub

Private Sub txtSalary_Change()
CheckEmpFields
End Sub

Private Sub txtSalary_GotFocus()
SelText txtSalary
End Sub

Private Sub txtSalary_KeyPress(KeyAscii As Integer)
If KeyAscii <> Asc(".") Then
    OnlyNum KeyAscii
End If
End Sub

Private Sub txtSalary_LostFocus()
If Len(txtSalary.Text) > 0 Then
    txtSalary.Text = Format$(txtSalary.Text, "#,##0.00")
End If
End Sub

Private Sub txtSocso_Change()
CheckEmpFields
End Sub

Private Sub txtSocso_GotFocus()
SelText txtSocso
End Sub

Private Sub txtTFN_Change()
CheckEmpFields
End Sub

Private Sub txtTFN_GotFocus()
SelText txtTFN
End Sub

Private Sub txtZip_Change()
CheckEmpFields
End Sub

Private Sub txtZip_GotFocus()
SelText txtZip
End Sub

Private Sub txtZip_KeyPress(KeyAscii As Integer)
OnlyNum KeyAscii
End Sub

Private Sub yyyyBirth_Click()
CheckEmpFields
End Sub

Private Sub yyyyBirth_GotFocus()
SelText yyyyBirth
End Sub

Private Sub yyyyBirth_KeyPress(KeyAscii As Integer)
OnlyNum KeyAscii
End Sub

Private Sub yyyyComm_Click()
CheckEmpFields
End Sub

Private Sub yyyyComm_GotFocus()
SelText yyyyComm
End Sub

Private Sub yyyyComm_KeyPress(KeyAscii As Integer)
OnlyNum KeyAscii
End Sub

Private Sub txtAddress_Change()
CheckEmpFields
End Sub

Private Sub txtAddress_GotFocus()
SelText txtAddress
End Sub

Private Sub txtAddress_LostFocus()
CapCon txtAddress
End Sub

Private Sub txtChildren_Change()
CheckEmpFields
End Sub

Private Sub txtChildren_GotFocus()
SelText txtChildren
End Sub

Private Sub txtChildren_KeyPress(KeyAscii As Integer)
KeyAscii = 0
End Sub

Private Sub txtChildren_LostFocus()
If Len(txtChildren.Text) = 0 Then
    txtChildren.Text = "0"
End If
End Sub
Private Sub optMarriedNo_Click()
If optMarriedYes.Value = True Then
    udChildren.Enabled = True
Else
    udChildren.Enabled = False
End If
CheckEmpFields
End Sub

Private Sub optMarriedYes_Click()
If optMarriedYes.Value = True Then
    udChildren.Enabled = True
Else
    udChildren.Enabled = False
End If
CheckEmpFields
End Sub
Private Sub Form_Load()
lblNotes.Caption = "* - Red labels indicate required fields." & vbCrLf & _
"Please enter all the required details carefully."
FillComboCountry cmbCountry
Dim tempSQL As String
Dim tempRS As Recordset
Dim i As Integer
i = 65
While Not i < 17
    yyyyBirth.addItem Format$(Year(Now()) - i)
    i = i - 1
Wend

For i = 0 To 20
    yyyyComm.addItem Format$(Year(Now()) - 10 + i)
'    yyyyResign.addItem Format$(Year(Now()) - 10 + i)
Next i
tempSQL = "SELECT Positions.PositionID FROM Positions ORDER BY Positions.PositionID ASC;"
FillCombo cmbPosition, tempSQL, "PositionID"
maxIncome = getSettings("maxSalary")

End Sub

Private Sub Form_Unload(Cancel As Integer)
Set frmEmployees_New = Nothing
End Sub

Private Sub mmBirth_Change()
CheckEmpFields
If Len(mmBirth.Text) = 2 Then
    yyyyBirth.SetFocus
End If
End Sub

Private Sub mmBirth_GotFocus()
SelText mmBirth
End Sub

Private Sub mmBirth_KeyPress(KeyAscii As Integer)
OnlyNum KeyAscii
End Sub

Private Sub mmBirth_LostFocus()
If Len(mmBirth.Text) > 0 Then
    mmBirth.Text = Format(mmBirth.Text, "00")
End If
End Sub
Private Sub cmbCity_Change()
CheckEmpFields
End Sub

Private Sub cmbCity_GotFocus()
If cmbCity.Text = "[PLEASE SELECT ONE]" Then
    cmbCity.Text = ""
End If
SelText cmbCity
End Sub

Private Sub cmbCity_LostFocus()
CapCon cmbCity
End Sub

Private Sub cmbCountry_Change()
CheckEmpFields
End Sub

Private Sub cmbCountry_Click()
FillComboState cmbState, cmbCountry.Text
End Sub

Private Sub cmbCountry_GotFocus()
If cmbCountry.Text = "[PLEASE SELECT ONE]" Then
    cmbCountry.Text = ""
End If
SelText cmbCountry
End Sub

Private Sub cmbCountry_LostFocus()
CapCon cmbCountry
End Sub

Private Sub cmbPosition_Change()
CheckEmpFields
End Sub

Private Sub cmbPosition_GotFocus()
SelText cmbPosition
End Sub

Private Sub cmbPosition_LostFocus()
CapCon cmbPosition
End Sub

Private Sub cmbRace_Change()
CheckEmpFields
End Sub

Private Sub cmbRace_GotFocus()
If cmbRace.Text = "[PLEASE SELECT ONE]" Then
    cmbRace.Text = ""
End If
SelText cmbRace
End Sub

Private Sub cmbState_Change()
CheckEmpFields
End Sub

Private Sub cmbState_Click()
FillComboCity cmbCity, cmbState.Text
End Sub

Private Sub cmbState_GotFocus()
If cmbState.Text = "[PLEASE SELECT ONE]" Then
    cmbState.Text = ""
End If
SelText cmbState
End Sub

Private Sub cmbState_LostFocus()
CapCon cmbState
End Sub

Private Sub cmdCancel_Click()
Unload Me
End Sub

Private Sub CheckEmpFields()
If (Len(txtName.Text) = 0) Or ((optMale.Value = False) And (optFemale.Value = False)) Or _
(Len(ddBirth.Text) = 0) Or (Len(mmBirth.Text) = 0) Or (Len(yyyyBirth.Text) = 0) Or (Len(txtIC.Text) = 0) Or _
(Len(cmbRace.Text) = 0) Or (Len(txtAddress.Text) = 0) Or (Len(cmbCountry.Text) = 0) Or (Len(cmbState.Text) = 0) Or _
(Len(cmbCity.Text) = 0) Or (Len(txtZip.Text) = 0) Or (Len(cmbPosition.Text) = 0) Or (Len(txtSalary.Text) = 0) Or _
(Len(ddComm.Text) = 0) Or (Len(mmComm.Text) = 0) Or (Len(yyyyComm.Text) = 0) Then
    cmdSave.Enabled = False
ElseIf (optMarriedYes.Value = True) And (Len(txtChildren.Text) = 0) Then
    cmdSave.Enabled = False
'ElseIf ((optResignYes.Value = True) And (optResignNo.Value = False)) And ((Len(ddResign.Text) = 0) Or (Len(mmResign.Text) = 0) Or (Len(yyyyResign.Text) = 0)) And (Len(cmbReason.Text) = 0) Then
'    cmdSave.Enabled = False
Else
    cmdSave.Enabled = True
End If
End Sub