frmsuppliers.frm

英文版Access数据库编程

End With
If CurrentUser.prvlgAdmin = True Then
    mnu_Account.Visible = True
Else
    mnu_Account.Visible = False
End If
End Sub

Private Sub Form_Resize()
On Error Resume Next
list_Suppliers.width = Me.ScaleWidth - list_Suppliers.Left * 2
list_History.width = Me.ScaleWidth - list_History.Left * 2
tb.width = Me.ScaleWidth - tb.Left * 2
tb.height = Me.ScaleHeight - tb.Left * 5
list_History.height = Me.ScaleHeight - list_History.Left * 5
End Sub

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

Private Sub list_Suppliers_DblClick()
If list_Suppliers.ListItems.Count > 0 Then
    If list_Suppliers.SelectedItem.Selected = True Then
        getSupplierInfo list_Suppliers.SelectedItem.Text
    End If
End If
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()
frmSupplier_New.Show vbModal
End Sub

Private Sub mnu_Options_Save_Click()
Call cmdSave_Click
End Sub

Private Sub mnu_PO_new_Click()
frmPurchase.Show , frmMain
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 txtName_KeyPress(KeyAscii As Integer)
OnlyAlpha KeyAscii
End Sub

Private Sub txtSupplierID_GotFocus()
SelText txtSupplierID
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
End Sub

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

Private Sub txtSupplierID_KeyPress(KeyAscii As Integer)
OnlyAlpha 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

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

Public Sub getSuppliers()
'Obtain list of Suppliers and display them on the list view control
'Format list
With list_Suppliers
    .View = lvwReport
    .ListItems.Clear
    .ColumnHeaders.Clear
    .ColumnHeaders.add , , "Supplier ID"
    .ColumnHeaders.add , , "Company Name", 4000
    
    'Define query
    Dim suppSQL As String
    suppSQL = "SELECT Suppliers.SupplierID, Suppliers.Name, Suppliers.CurrentBalance, Suppliers.CreditLimit FROM Suppliers ORDER BY Suppliers.SupplierID;"
    
    Dim suppRS As Recordset
    
    On Error GoTo ErrHandler
    'Open recordset
    RSOpen suppRS, suppSQL, dbOpenSnapshot
    While Not suppRS.EOF
        'Run through all records and add them to list
        .ListItems.add , , suppRS("SupplierID") ' (IIf((suppRS("CurrentBalance") > suppRS("CreditLimit")) , imgList.Image(1), imgList.Image(2)))
        .ListItems(.ListItems.Count).SubItems(1) = suppRS("Name")
        suppRS.MoveNext
    Wend
    suppRS.Close
    Set suppRS = Nothing

FormMode Viewing
End With

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

Private Sub FormMode(strModeName As ModeStatus)
If strModeName = Editing Then
    list_Suppliers.Enabled = False
    txtSupplierID.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
Else
    list_Suppliers.Enabled = True
    txtSupplierID.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 If
End Sub

Private Sub getSupplierInfo(ByVal strSupplierID As String)
'Obtains the particular Supplier information and place them into respective controls
Dim InfoSQL As String
InfoSQL = "SELECT * FROM Suppliers WHERE Suppliers.SupplierID='" & strSupplierID & "';"

Dim InfoRS As Recordset

On Error Resume Next
RSOpen InfoRS, InfoSQL, dbOpenSnapshot
If Not InfoRS.EOF Then
    txtSupplierID.Text = strSupplierID
    lblhidden.Caption = InfoRS("SupplierID")
    txtName.Text = InfoRS("Name")
    txtAddress.Text = InfoRS("Address")
    cmbCountry.Text = InfoRS("Country")
    cmbState.Text = InfoRS("State")
    cmbCity.Text = InfoRS("City")
    txtZip.Text = 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 FieldCheck()
If (Len(txtSupplierID.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 getSupplierHistory(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 supp_transactions WHERE SupplierID='" & lblhidden.Caption & "'"
    Case "Purchases"
        strCon = "debit"
        hisSQL = "SELECT notes, date, debit FROM supp_transactions WHERE SupplierID='" & lblhidden.Caption & "'"
    Case "All"
        strCon = "All"
        hisSQL = "SELECT notes,date,credit, debit FROM supp_transactions WHERE SupplierID='" & 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", 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("credit") - hisRS("debit")
                .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) > 0 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