frmcustomers.frm

英文版Access数据库编程

Private Sub list_Customers_ItemClick(ByVal Item As MSComctlLib.ListItem)
With Item
If .Selected Then
    getCustomerInfo .Text
End If
End With
End Sub

Private Sub mnu_Acc_Adjust_Click()
If lblHidden.Caption <> "" Then
    Load frmAdjustment
    frmAdjustment.setAccType "Customer"
    frmAdjustment.Tag = lblHidden.Caption
    frmAdjustment.Show vbModal
End If
End Sub

Private Sub mnu_Account_Click()
If lblHidden.Caption = "" Then
    mnu_Acc_Adjust.Enabled = False
Else
    mnu_Acc_Adjust.Enabled = True
End If
End Sub

Private Sub mnu_DO_New_Click()
frmDelivery.Show , frmMain
End Sub

Private Sub mnu_DO_Payment_Click()
frmCustomer_Payment.Show vbModal
End Sub

Private Sub mnu_Options_Cancel_Click()
Call cmdCancel_Click
End Sub

Private Sub mnu_Options_Edit_Click()
Call cmdEdit_Click
End Sub

Private Sub mnu_Options_Exit_Click()
Call cmdClose_Click
End Sub

Private Sub mnu_Options_New_Click()
frmCustomer_New.Show vbModal
End Sub

Private Sub mnu_Options_Save_Click()
Call cmdSave_Click
End Sub

Private Sub tb_Click()
If tb.SelectedItem.Selected = True Then
    getCustomerHistory tb.SelectedItem.Caption
End If
End Sub

Private Sub txtAddress_GotFocus()
SelText txtAddress
End Sub

Private Sub txtAddress_LostFocus()
CapCon txtAddress
End Sub

Private Sub txtBalance_GotFocus()
SelText txtBalance
End Sub

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

Private Sub txtCustomerID_GotFocus()
SelText txtCustomerID
End Sub

Private Sub txtFax1_GotFocus(Index As Integer)
SelText txtFax1(Index)
End Sub

Private Sub txtFax1_KeyPress(Index As Integer, KeyAscii As Integer)
OnlyNum KeyAscii
End Sub

Private Sub txtFax2_GotFocus(Index As Integer)
SelText txtFax2(Index)
End Sub

Private Sub txtFax2_KeyPress(Index As Integer, KeyAscii As Integer)
OnlyNum KeyAscii
End Sub

Private Sub txtLimit_GotFocus()
SelText txtLimit
End Sub

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

Private Sub txtName_GotFocus()
SelText txtName
End Sub

Private Sub txtName_LostFocus()
CapCon txtName
End Sub

Private Sub txtPhone1_GotFocus(Index As Integer)
SelText txtPhone1(Index)
End Sub

Private Sub txtPhone1_KeyPress(Index As Integer, KeyAscii As Integer)
OnlyNum KeyAscii
End Sub

Private Sub txtPhone2_GotFocus(Index As Integer)
SelText txtPhone2(Index)
End Sub

Private Sub txtPhone2_KeyPress(Index As Integer, KeyAscii As Integer)
OnlyNum KeyAscii
End Sub

Private Sub txtTerm_GotFocus()
SelText txtTerm
End Sub

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

Private Sub txtZip_GotFocus()
SelText txtZip
End Sub

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

Public Sub getCustomers()
'Obtain list of customers and display them on the list view control
'Format list
With list_Customers
    .View = lvwReport
    .ListItems.Clear
    .ColumnHeaders.Clear
    .ColumnHeaders.add , , "Customer ID"
    .ColumnHeaders.add , , "Company Name", 4000
'Define query
Dim custSQL As String
custSQL = "SELECT Customers.CustomerID, Customers.Name, Customers.CurrentBalance, Customers.CreditLimit FROM Customers ORDER BY Customers.CustomerID;"

Dim custRS As Recordset

On Error GoTo ErrHandler
'Open recordset
RSOpen custRS, custSQL, dbOpenSnapshot
While Not custRS.EOF
    'Run through all records and add them to list
    .ListItems.add , , custRS("CustomerID") ' (IIf((custRS("CurrentBalance") > custRS("CreditLimit")) , imgList.Image(1), imgList.Image(2)))
    .ListItems(.ListItems.Count).SubItems(1) = custRS("Name")
    custRS.MoveNext
Wend
custRS.Close
Set custRS = Nothing
End With
FormMode Viewing

ErrHandler:
If Err.Number <> 0 Then
    Screen.MousePointer = 0
    CriticalMsg "Unable to load list of customers. Please contact system administrator.", "Warning"
    Exit Sub
End If
End Sub

Private Sub FormMode(ModeName As ModeStatus)
'sets the current mode of the form
Select Case ModeName
Case Editing
    list_Customers.Enabled = False
    txtCustomerID.Enabled = True
    txtName.Enabled = True
    txtAddress.Enabled = True
    cmbCountry.Enabled = True
    cmbState.Enabled = True
    cmbCity.Enabled = True
    txtZip.Enabled = True
    txtPhone1(0).Enabled = True
    txtPhone1(1).Enabled = True
    txtPhone2(0).Enabled = True
    txtPhone2(1).Enabled = True
    txtFax1(0).Enabled = True
    txtFax1(1).Enabled = True
    txtFax2(0).Enabled = True
    txtFax2(1).Enabled = True
    txtLimit.Enabled = True
    txtEmail.Enabled = True
    udTerm.Enabled = True
    cmdEdit.Visible = False
    cmdClose.Visible = False
    mnu_Options_Exit.Enabled = False
    mnu_Options_Edit.Enabled = False
    mnu_Options_New.Enabled = False
    mnu_Options_Save.Enabled = True
    mnu_Options_Cancel.Enabled = True
Case Viewing
    list_Customers.Enabled = True
    txtCustomerID.Enabled = False
    txtName.Enabled = False
    txtAddress.Enabled = False
    cmbCountry.Enabled = False
    cmbState.Enabled = False
    cmbCity.Enabled = False
    txtZip.Enabled = False
    txtPhone1(0).Enabled = False
    txtPhone1(1).Enabled = False
    txtPhone2(0).Enabled = False
    txtPhone2(1).Enabled = False
    txtFax1(0).Enabled = False
    txtFax1(1).Enabled = False
    txtFax2(0).Enabled = False
    txtFax2(1).Enabled = False
    txtLimit.Enabled = False
    txtEmail.Enabled = False
    udTerm.Enabled = False
    cmdEdit.Visible = True
    cmdClose.Visible = True
    mnu_Options_Exit.Enabled = True
    mnu_Options_Edit.Enabled = True
    mnu_Options_New.Enabled = True
    mnu_Options_Save.Enabled = False
    mnu_Options_Cancel.Enabled = False
End Select
End Sub

Private Sub getCustomerInfo(ByVal strCustomerID As String)
'Obtains the particular customer information and place them into respective controls
Dim InfoSQL As String
InfoSQL = "SELECT * FROM Customers WHERE Customers.CustomerID='" & strCustomerID & "';"

Dim InfoRS As Recordset

On Error Resume Next
RSOpen InfoRS, InfoSQL, dbOpenSnapshot
If Not InfoRS.EOF Then
    txtCustomerID.Text = strCustomerID
    lblHidden.Caption = InfoRS("CustomerID")
    txtName.Text = InfoRS("Name")
    txtAddress.Text = InfoRS("Address")
    cmbCountry.Text = InfoRS("Country")
    cmbState.Text = InfoRS("State")
    cmbCity.Text = InfoRS("City")
    txtZip.Text = IIf(IsNull(InfoRS("Zip")), "", InfoRS("Zip"))
    txtPhone1(0).Text = InfoRS("ACPhone1")
    txtPhone1(1).Text = InfoRS("Phone1")
    txtPhone2(0).Text = InfoRS("ACPhone2")
    txtPhone2(1).Text = InfoRS("Phone2")
    txtFax1(0).Text = InfoRS("ACFax1")
    txtFax1(1).Text = InfoRS("Fax1")
    txtFax2(0).Text = InfoRS("ACFax2")
    txtFax2(1).Text = InfoRS("Fax2")
    txtEmail.Text = IIf(IsNull(InfoRS("Email")), "", InfoRS("Email"))
    txtLimit.Text = Format$(InfoRS("CreditLimit"), "#,##0.00")
    txtTerm.Text = InfoRS("CreditTerm")
    txtBalance.Text = Format$(InfoRS("CurrentBalance"), "#,##0.00")
End If
InfoRS.Close
Set InfoRS = Nothing
list_History.ListItems.Clear
tb.Tabs(0).Selected = True
End Sub

Private Sub getCustomerHistory(ByVal strSection As String)
'Gets the history of the customer based on the parameter passed
Dim hisSQL As String, strCon As String
Dim hisRS As Recordset
strCon = ""
Select Case strSection
    Case "Payment"
        strCon = "credit"
        hisSQL = "SELECT notes, date, credit FROM cust_transactions WHERE CustomerID='" & lblHidden.Caption & "'"
    Case "Delivery"
        strCon = "debit"
        hisSQL = "SELECT notes, date, debit FROM cust_transactions WHERE CustomerID='" & lblHidden.Caption & "'"
    Case "All"
        strCon = "All"
        hisSQL = "SELECT notes,date,debit,credit FROM cust_transactions WHERE CustomerID='" & lblHidden.Caption & "'"
End Select
With list_History
    .View = lvwReport
    'Clear the history contents
    .ColumnHeaders.Clear
    .ListItems.Clear
    'Re-format the properties
    .ColumnHeaders.add , , "Date"
    .ColumnHeaders.add , , "Description"
    .ColumnHeaders(2).width = 4470
    If strSection = "All" Then
        .ColumnHeaders.add , , "Debit" '2
        .ColumnHeaders.add , , "Credit" '3
        .ColumnHeaders.add , , "Balance" '4
    Else
        .ColumnHeaders.add , , "Amount" '2
    End If
End With
Dim currBalance As Double
currBalance = 0
If strCon <> "" Then
    On Error GoTo ErrHandler
    RSOpen hisRS, hisSQL, dbOpenSnapshot
    While Not hisRS.EOF
        With list_History.ListItems
            If strCon = "All" Then
                .add , , hisRS("date")
                .Item(.Count).SubItems(1) = hisRS("notes")
                .Item(.Count).SubItems(2) = Format$(hisRS("debit"), "#,##0.00")
                .Item(.Count).SubItems(3) = Format$(hisRS("credit"), "#,##0.00")
                currBalance = currBalance + hisRS("debit") - hisRS("credit")
                .Item(.Count).SubItems(4) = Format$(currBalance, "#,##0.00")
                
            ElseIf strCon = "debit" Then
                If hisRS(strCon) > 0 Then
                    .add , , hisRS("date")
                    .Item(.Count).SubItems(1) = hisRS("notes")
                    .Item(.Count).SubItems(2) = Format$(hisRS("debit"), "#,##0.00")
                End If
            Else
                If hisRS(strCon) Then
                    .add , , hisRS("date")
                    .Item(.Count).SubItems(1) = hisRS("notes")
                    .Item(.Count).SubItems(2) = Format$(hisRS("credit"), "#,##0.00")
                End If
            End If
        End With
        hisRS.MoveNext
    Wend
    hisRS.Close
    Set hisRS = Nothing
End If
ErrHandler:
If Err.Number <> 0 Then
    ErrorNotifier Err.Number, Err.description
    Exit Sub
End If
End Sub
Private Sub FieldCheck()
If (Len(txtCustomerID.Text) = 0) Or (Len(txtName.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(txtPhone1(0).Text) = 0) Or (Len(txtPhone1(1).Text) = 0) Or (Len(txtPhone2(0).Text) = 0) Or (Len(txtPhone2(1).Text) = 0) Or _
(Len(txtFax1(0).Text) = 0) Or (Len(txtFax1(1).Text) = 0) Or (Len(txtFax2(0).Text) = 0) Or (Len(txtFax2(1).Text) = 0) Or _
(Len(txtLimit.Text) = 0) Then
    cmdSave.Enabled = False
    mnu_Options_Save.Enabled = False
Else
    cmdSave.Enabled = True
    mnu_Options_Save.Enabled = True
End If
End Sub

Private Sub printInvoice(ByVal strCustID As String)
Dim tSQL As String
tSQL = "SELECT Delivery.DOnumber, Delivery.Date, Delivery.Status, Sum(([D_Details].[Quantity]*[D_Details].[SalePrice])+[Delivery].[Charges]) AS Total " & _
"FROM (Customers INNER JOIN Delivery ON Customers.CustomerID = Delivery.CustomerID) INNER JOIN D_Details ON Delivery.DOnumber = D_Details.DOnumber " & _
"Where (((Customers.CustomerID) = '" & strCustID & "') And ((D_Details.isInvoiced) = True)) " & _
"GROUP BY Delivery.DOnumber, Delivery.Date, Delivery.Status " & _
"HAVING (((Delivery.Status)='INVOICED'));"


End Sub