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
arrow
arrow
    全站熱搜

    vbqa 發表在 痞客邦 留言(0) 人氣()