Dim Control As Integer
Dim confirm As Integer
Dim CusName As String
Dim Address As String
Dim Phone As Integer
Dim Email As String
Dim LeasDate As Date
Dim NIRC As Integer
Dim Manufacturer As String
Dim Model As String
Dim SerialNo As Integer
Dim Color As String
Dim Description As String
Dim PhonePrice As Currency
Dim DownPayment As Currency
Dim Interest As Integer
Dim Period As Integer
Private Sub cmdClear_Click()
txtCusName = ""
txtAddress = ""
txtPhone = ""
txtEmail = ""
txtNIRC = ""
txtManufacturer = ""
txtModel = ""
txtSerialNo = ""
txtColor = ""
txtDescription = ""
txtPhonePrice = ""
txtDownPayment = ""
txtInterest = ""
txtPeriod = ""
End Sub
Private Sub cmdDelete_Click()
On Error GoTo DeleteErr
confirm = MsgBox("Are you sure that you want to delete the record?", vbOKCancel, "Record Deletion")
If confirm = 0 Then
Exit Sub
Else
ProgressBar1.Value = 0
Do While ProgressBar1.Value <= 10000
ProgressBar1.Value = ProgressBar1.Value + 1
Loop
ProgressBar1.Value = 0
With datPrimaryRS.Recordset
.Delete
.MoveNext
If .EOF Then .MoveLast
End With
MsgBox "Record deleted successfully!", vbOKOnly, "Record Deletion"
Exit Sub
End If
cmdExit.Enabled = True
DeleteErr:
MsgBox Err.Description
End Sub
Private Sub cmdSearch_Click()
Unload Me
frmSearchCus.Show
End Sub
Private Sub cmdUpdate_Click()
On Error GoTo UpdateErr
ProgressBar1.Value = 0
Do While ProgressBar1.Value <= 10000
ProgressBar1.Value = ProgressBar1.Value + 1
Loop
ProgressBar1.Value = 0
datPrimaryRS.Recordset.UpdateBatch adAffectAll
Exit Sub
UpdateErr:
MsgBox Err.Description
End Sub
Private Sub Form_Load()
datPrimaryRS.Recordset.AddNew
cmdExit.Enabled = False
txtCustomerID.BackColor = vbCyan
txtDate.BackColor = vbCyan
txtDate = Format(Now, "dd/mmm/yyyy")
End Sub
Private Sub Form_Unload(Cancel As Integer)
Screen.MousePointer = vbDefault
End Sub
Private Sub datPrimaryRS_Error(ByVal ErrorNumber As Long, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, fCancelDisplay As Boolean)
'This is where you would put error handling code
'If you want to ignore errors, comment out the next line
'If you want to trap them, add code here to handle them
MsgBox "Data error event hit err:" & Description
End Sub
Private Sub datPrimaryRS_MoveComplete(ByVal adReason As ADODB.EventReasonEnum, ByVal pError As ADODB.Error, adStatus As ADODB.EventStatusEnum, ByVal pRecordset As ADODB.Recordset)
'This will display the current record position for this recordset
datPrimaryRS.Caption = "Record: " & CStr(datPrimaryRS.Recordset.AbsolutePosition)
End Sub
Private Sub datPrimaryRS_WillChangeRecord(ByVal adReason As ADODB.EventReasonEnum, ByVal cRecords As Long, adStatus As ADODB.EventStatusEnum, ByVal pRecordset As ADODB.Recordset)
'This is where you put validation code
'This event gets called when the following actions occur
Dim bCancel As Boolean
Select Case adReason
Case adRsnAddNew
Case adRsnClose
Case adRsnDelete
Case adRsnFirstChange
Case adRsnMove
Case adRsnRequery
Case adRsnResynch
Case adRsnUndoAddNew
Case adRsnUndoDelete
Case adRsnUndoUpdate
Case adRsnUpdate
End Select
If bCancel Then adStatus = adStatusCancel
End Sub
Private Sub cmdAdd_Click()
On Error GoTo AddErr
CusName = txtCusName.Text
Address = txtAddress.Text
Phone = txtPhone.Text
Email = txtEmail.Text
NIRC = txtNIRC.Text
Manufacturer = txtManufacturer.Text
Model = txtModel.Text
SerialNo = txtSerialNo.Text
Color = txtColor.Text
Description = txtDescription.Text
PhonePrice = txtPhonePrice.Text
DownPayment = txtDownPayment.Text
Interest = txtInterest.Text
Period = txtPeriod.Text
datPrimaryRS.Recordset.AddNew
ProgressBar1.Value = 0
cmdAdd.Enabled = True
Do While ProgressBar1.Value <= 10000
ProgressBar1.Value = ProgressBar1.Value + 1
Loop
ProgressBar1.Value = 0
datPrimaryRS.Refresh
MsgBox "Leasing information has been stored successfully!", vbOKOnly, "Add Record"
datPrimaryRS.Recordset.Find "CusName = '" + txtCusName.Text + "'", 0, adSearchForward
If datPrimaryRS.Recordset.EOF = True Then
datPrimaryRS.Refresh
MsgBox "Error!", vbCritical, "Add Record Error"
End If
CusID = txtCustomerID.Text
txtCustomerID.BackColor = vbWhite
cmdExit.Enabled = True
Exit Sub
AddErr:
MsgBox "Please fill in all required data!", vbOKOnly, "Error"
End Sub
Private Sub cmdExit_Click()
Unload Me
frmLogin.Show
End Sub
Private Sub cmdSave_Click()
Dim Control As Integer
On Error GoTo SaveErr
datPrimaryRS.Recordset.MoveLast
Control = txtCusID.Text
datPrimaryRS.Recordset.AddNew
If datPrimaryRS.Recordset.RecordCount = 0 Then
txtCusID = 0
Else
txtCusID = Control + 1
End If
txtCusName.SetFocus
Exit Sub
AddErr:
MsgBox Err.Description
End Sub
Private Sub Checking()
On Error GoTo ErrorMessage
Control = 1
If txtCusName.Text = "" Then
MsgBox "Please Enter Your Name!!", 0, "Error"
With txtCusName
txtCusName.Text = ""
txtCusName.SetFocus
End With
ElseIf Not IsNumeric(txtNIRC.Text) Then
MsgBox "Please enter the Fax Number correctly !!"
With txtNIRC
txtNIRC.Text = ""
txtNIRC.SetFocus
End With
ElseIf Not IsNumeric(txtInterest.Text) Then
MsgBox "Please enter the Discount rate correctly !!"
With txtInterest
txtInterest.Text = ""
txtInterest.SetFocus
End With
Else: Control = 0
End If
Exit Sub
ErrorMessage:
MsgBox Err.Description
End Sub
Dim confirm As Integer
Dim CusName As String
Dim Address As String
Dim Phone As Integer
Dim Email As String
Dim LeasDate As Date
Dim NIRC As Integer
Dim Manufacturer As String
Dim Model As String
Dim SerialNo As Integer
Dim Color As String
Dim Description As String
Dim PhonePrice As Currency
Dim DownPayment As Currency
Dim Interest As Integer
Dim Period As Integer
Private Sub cmdClear_Click()
txtCusName = ""
txtAddress = ""
txtPhone = ""
txtEmail = ""
txtNIRC = ""
txtManufacturer = ""
txtModel = ""
txtSerialNo = ""
txtColor = ""
txtDescription = ""
txtPhonePrice = ""
txtDownPayment = ""
txtInterest = ""
txtPeriod = ""
End Sub
Private Sub cmdDelete_Click()
On Error GoTo DeleteErr
confirm = MsgBox("Are you sure that you want to delete the record?", vbOKCancel, "Record Deletion")
If confirm = 0 Then
Exit Sub
Else
ProgressBar1.Value = 0
Do While ProgressBar1.Value <= 10000
ProgressBar1.Value = ProgressBar1.Value + 1
Loop
ProgressBar1.Value = 0
With datPrimaryRS.Recordset
.Delete
.MoveNext
If .EOF Then .MoveLast
End With
MsgBox "Record deleted successfully!", vbOKOnly, "Record Deletion"
Exit Sub
End If
cmdExit.Enabled = True
DeleteErr:
MsgBox Err.Description
End Sub
Private Sub cmdSearch_Click()
Unload Me
frmSearchCus.Show
End Sub
Private Sub cmdUpdate_Click()
On Error GoTo UpdateErr
ProgressBar1.Value = 0
Do While ProgressBar1.Value <= 10000
ProgressBar1.Value = ProgressBar1.Value + 1
Loop
ProgressBar1.Value = 0
datPrimaryRS.Recordset.UpdateBatch adAffectAll
Exit Sub
UpdateErr:
MsgBox Err.Description
End Sub
Private Sub Form_Load()
datPrimaryRS.Recordset.AddNew
cmdExit.Enabled = False
txtCustomerID.BackColor = vbCyan
txtDate.BackColor = vbCyan
txtDate = Format(Now, "dd/mmm/yyyy")
End Sub
Private Sub Form_Unload(Cancel As Integer)
Screen.MousePointer = vbDefault
End Sub
Private Sub datPrimaryRS_Error(ByVal ErrorNumber As Long, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, fCancelDisplay As Boolean)
'This is where you would put error handling code
'If you want to ignore errors, comment out the next line
'If you want to trap them, add code here to handle them
MsgBox "Data error event hit err:" & Description
End Sub
Private Sub datPrimaryRS_MoveComplete(ByVal adReason As ADODB.EventReasonEnum, ByVal pError As ADODB.Error, adStatus As ADODB.EventStatusEnum, ByVal pRecordset As ADODB.Recordset)
'This will display the current record position for this recordset
datPrimaryRS.Caption = "Record: " & CStr(datPrimaryRS.Recordset.AbsolutePosition)
End Sub
Private Sub datPrimaryRS_WillChangeRecord(ByVal adReason As ADODB.EventReasonEnum, ByVal cRecords As Long, adStatus As ADODB.EventStatusEnum, ByVal pRecordset As ADODB.Recordset)
'This is where you put validation code
'This event gets called when the following actions occur
Dim bCancel As Boolean
Select Case adReason
Case adRsnAddNew
Case adRsnClose
Case adRsnDelete
Case adRsnFirstChange
Case adRsnMove
Case adRsnRequery
Case adRsnResynch
Case adRsnUndoAddNew
Case adRsnUndoDelete
Case adRsnUndoUpdate
Case adRsnUpdate
End Select
If bCancel Then adStatus = adStatusCancel
End Sub
Private Sub cmdAdd_Click()
On Error GoTo AddErr
CusName = txtCusName.Text
Address = txtAddress.Text
Phone = txtPhone.Text
Email = txtEmail.Text
NIRC = txtNIRC.Text
Manufacturer = txtManufacturer.Text
Model = txtModel.Text
SerialNo = txtSerialNo.Text
Color = txtColor.Text
Description = txtDescription.Text
PhonePrice = txtPhonePrice.Text
DownPayment = txtDownPayment.Text
Interest = txtInterest.Text
Period = txtPeriod.Text
datPrimaryRS.Recordset.AddNew
ProgressBar1.Value = 0
cmdAdd.Enabled = True
Do While ProgressBar1.Value <= 10000
ProgressBar1.Value = ProgressBar1.Value + 1
Loop
ProgressBar1.Value = 0
datPrimaryRS.Refresh
MsgBox "Leasing information has been stored successfully!", vbOKOnly, "Add Record"
datPrimaryRS.Recordset.Find "CusName = '" + txtCusName.Text + "'", 0, adSearchForward
If datPrimaryRS.Recordset.EOF = True Then
datPrimaryRS.Refresh
MsgBox "Error!", vbCritical, "Add Record Error"
End If
CusID = txtCustomerID.Text
txtCustomerID.BackColor = vbWhite
cmdExit.Enabled = True
Exit Sub
AddErr:
MsgBox "Please fill in all required data!", vbOKOnly, "Error"
End Sub
Private Sub cmdExit_Click()
Unload Me
frmLogin.Show
End Sub
Private Sub cmdSave_Click()
Dim Control As Integer
On Error GoTo SaveErr
datPrimaryRS.Recordset.MoveLast
Control = txtCusID.Text
datPrimaryRS.Recordset.AddNew
If datPrimaryRS.Recordset.RecordCount = 0 Then
txtCusID = 0
Else
txtCusID = Control + 1
End If
txtCusName.SetFocus
Exit Sub
AddErr:
MsgBox Err.Description
End Sub
Private Sub Checking()
On Error GoTo ErrorMessage
Control = 1
If txtCusName.Text = "" Then
MsgBox "Please Enter Your Name!!", 0, "Error"
With txtCusName
txtCusName.Text = ""
txtCusName.SetFocus
End With
ElseIf Not IsNumeric(txtNIRC.Text) Then
MsgBox "Please enter the Fax Number correctly !!"
With txtNIRC
txtNIRC.Text = ""
txtNIRC.SetFocus
End With
ElseIf Not IsNumeric(txtInterest.Text) Then
MsgBox "Please enter the Discount rate correctly !!"
With txtInterest
txtInterest.Text = ""
txtInterest.SetFocus
End With
Else: Control = 0
End If
Exit Sub
ErrorMessage:
MsgBox Err.Description
End Sub
全站熱搜
留言列表