form14.frm

我用VB开发的饲料经营进销存管理程序,包含购入、售出管理

        f_reckon_table(j, 7) = rs1.Fields(7).Value
        f_reckon_table(j, 8) = rs1.Fields(8).Value
        f_reckon_table(j, 9) = rs1.Fields(9).Value
        j = j + 1
        rs1.MoveNext
        List1.ListIndex = 0
    Wend
    f_current_row = 0
    SQL = "select * from 欠款收回表 where 帐单号 = " & _
    "'" & f_reckon_table(f_current_row, 5) & "'" & " and 帐本号= " & "'" & f_reckon_table(f_current_row, 4) & "'"
    With cmd1
        .ActiveConnection = cnn1
        .CommandText = SQL
        .CommandType = adCmdText
    End With
    Set rs1 = cmd1.Execute
    If rs1.EOF Then
        cnn1.Close
        Set cnn1 = Nothing
        GoTo exit_form_load
    End If
    j = 0
    List2.Clear
    rs1.MoveFirst
    While Not rs1.EOF
        S = ""
        For i = 0 To rs1.Fields.Count - 1
            Select Case i
                Case 3
                    date_string = Round(rs1.Fields(2).Value, 0) & "年" & _
                    Round(rs1.Fields(4).Value, 0) & "月" & _
                    Round(rs1.Fields(5).Value, 0) & "日"
                    t_len = 14 - Len(date_string)
                    S1 = ""
                    For t = 1 To t_len
                        S1 = S1 & " "
                    Next
                    S = S & date_string & S1
                Case 6
                    t_len = 0
                    t_value = Round(rs1.Fields(i).Value, 2)
                    t_len = 11 - Len(t_value)
                    S1 = ""
                    If t_value = Int(t_value) Then
                        S1 = S1 & ".00"
                        t_len = t_len - 3
                    Else
                        If (t_value * 10) = Int(t_value * 10) Then
                            S1 = S1 & "0"
                            t_len = t_len - 1
                        End If
                    End If
                    For t = 1 To t_len
                        S1 = S1 & " "
                    Next
                    S = S & t_value & S1
                Case Else
            End Select
        Next
        List2.AddItem S, j
        f_repay_table(j, 0) = rs1.Fields(0).Value
        f_repay_table(j, 1) = rs1.Fields(1).Value
        f_repay_table(j, 2) = rs1.Fields(2).Value
        f_repay_table(j, 3) = rs1.Fields(3).Value
        f_repay_table(j, 4) = rs1.Fields(4).Value
        f_repay_table(j, 5) = rs1.Fields(5).Value
        f_repay_table(j, 6) = rs1.Fields(6).Value
        j = j + 1
        rs1.MoveNext
        List2.ListIndex = 0
    Wend
    cnn1.Close
    Set cnn1 = Nothing
exit_form_load:
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Form32.Show
End Sub

Private Sub List1_Click()
    Dim cnn1 As ADODB.Connection
    Dim cmd1 As ADODB.Command
    Dim rs1 As ADODB.Recordset
    Set cnn1 = New ADODB.Connection
    cnn1.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
    "Data Source=C:\Documents and Settings\jujumao\My Documents\粤丰饲料\粤丰饲料经营情况.mdb;"
    Set cmd1 = New ADODB.Command
    j = List1.ListIndex
    If f_current_row = j Then
        GoTo exit_list1_click
    End If
    f_current_row = j
    SQL = "select * from 欠款收回表 where 帐单号 = " & _
    "'" & f_reckon_table(f_current_row, 5) & "'" & " and 帐本号= " & "'" & f_reckon_table(f_current_row, 4) & "'"
    With cmd1
        .ActiveConnection = cnn1
        .CommandText = SQL
        .CommandType = adCmdText
    End With
    Set rs1 = cmd1.Execute
    If rs1.EOF Then
        'MsgBox ("没有对应的欠款返还明细数据!")
        cnn1.Close
        Set cnn1 = Nothing
        GoTo exit_list1_click
    End If
    j = 0
    'sum_money = 0
    rs1.MoveFirst
    List2.Clear
    While Not rs1.EOF
        S = ""
        For i = 0 To rs1.Fields.Count - 1
            Select Case i
                Case 3
                    date_string = Round(rs1.Fields(3).Value, 0) & "年" & _
                    Round(rs1.Fields(4).Value, 0) & "月" & _
                    Round(rs1.Fields(5).Value, 0) & "日"
                    t_len = 12 - Len(date_string)
                    S1 = ""
                    For t = 1 To t_len
                        S1 = S1 & " "
                    Next
                    S = S & date_string & S1
                Case 6
                    t_len = 0
                    t_value = Round(rs1.Fields(i).Value, 2)
                    t_len = 11 - Len(t_value)
                    S1 = ""
                    If t_value = Int(t_value) Then
                        S1 = S1 & ".00"
                        t_len = t_len - 3
                    Else
                        If (t_value * 10) = Int(t_value * 10) Then
                            S1 = S1 & "0"
                            t_len = t_len - 1
                        End If
                    End If
                    For t = 1 To t_len
                        S1 = S1 & " "
                    Next
                    S = S & t_value & S1
                Case Else
            End Select
        Next
        List2.AddItem S, j
        f_repay_table(j, 0) = rs1.Fields(0).Value
        f_repay_table(j, 1) = rs1.Fields(1).Value
        f_repay_table(j, 2) = rs1.Fields(2).Value
        f_repay_table(j, 3) = rs1.Fields(3).Value
        f_repay_table(j, 4) = rs1.Fields(4).Value
        f_repay_table(j, 5) = rs1.Fields(5).Value
        f_repay_table(j, 6) = rs1.Fields(6).Value
        j = j + 1
        rs1.MoveNext
        List2.ListIndex = 0
    Wend
    cnn1.Close
    Set cnn1 = Nothing
exit_list1_click:
End Sub

Private Sub List3_GotFocus_fail()
    Dim cnn1 As ADODB.Connection
    Dim cmd1 As ADODB.Command
    Dim rs1 As ADODB.Recordset
    Set cnn1 = New ADODB.Connection
    cnn1.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
    "Data Source=C:\Documents and Settings\jujumao\My Documents\粤丰饲料\粤丰饲料经营情况.mdb;"
    Set cmd1 = New ADODB.Command
    List1.Clear
    For Row = 0 To List3.ListCount - 1
        Select Case g_query_method
            Case 1
                SQL = "select * from 帐单表 where 欠款金额>0 and 欠款金额=还款金额 and 帐本号 = " & _
                    "'" & List3.List(Row) & "'" & " order by 帐本号,年份,月份,日期"
            Case 2
                SQL = "select * from 帐单表 where 欠款金额>0 and 欠款金额<>还款金额 and 帐本号 = " & _
                    "'" & List3.List(Row) & "'" & "order by 帐本号,年份,月份,日期"
        End Select
        With cmd1
            .ActiveConnection = cnn1
            .CommandText = SQL
            .CommandType = adCmdText
        End With
        Set rs1 = cmd1.Execute
        If rs1.EOF Then
            MsgBox ("没有查询到记录")
            cnn1.Close
            Set cnn1 = Nothing
            GoSub exit_list3_getfocus
        End If
        j = 0
        rs1.MoveFirst
        While Not rs1.EOF
            S = ""
            For i = 1 To rs1.Fields.Count - 1
                Select Case i
                    Case 4, 5
                        tt_len = Len(rs1.Fields(i).Value)
                        t_len = 0
                        For t = 1 To tt_len
                            If Asc((Mid((rs1.Fields(i).Value), t, 1))) < 0 Then
                                t_len = t_len + 2
                            Else
                                t_len = t_len + 1
                            End If
                        Next
                        t_len = 12 - t_len
                        S1 = ""
                        For t = 1 To t_len
                            S1 = S1 & " "
                        Next
                        S = S & rs1.Fields(i).Value & S1
                    Case 7, 8
                        t_len = 0
                        t_value = Round(rs1.Fields(i).Value, 2)
                        t_len = 11 - Len(t_value)
                        S1 = ""
                        If t_value = Int(t_value) Then
                            S1 = S1 & ".00"
                            t_len = t_len - 3
                        Else
                            If (t_value * 10) = Int(t_value * 10) Then
                                S1 = S1 & "0"
                                t_len = t_len - 1
                            End If
                        End If
                        For t = 1 To t_len
                            S1 = S1 & " "
                        Next
                        S = S & t_value & S1
                    Case 1
                        date_string = Round(rs1.Fields(1).Value, 0) & "年" & _
                        Round(rs1.Fields(2).Value, 0) & "月" & _
                        Round(rs1.Fields(3).Value, 0) & "日"
                        t_len = 14 - Len(date_string)
                        S1 = ""
                        For t = 1 To t_len
                            S1 = S1 & " "
                        Next
                        S = S & date_string & S1
                End Select
            Next
            List1.AddItem S, j
            f_reckon_table(j, 0) = rs1.Fields(0).Value
            f_reckon_table(j, 1) = rs1.Fields(1).Value
            f_reckon_table(j, 2) = rs1.Fields(2).Value
            f_reckon_table(j, 3) = rs1.Fields(3).Value
            f_reckon_table(j, 4) = rs1.Fields(4).Value
            f_reckon_table(j, 5) = rs1.Fields(5).Value
            f_reckon_table(j, 7) = rs1.Fields(7).Value
            f_reckon_table(j, 8) = rs1.Fields(8).Value
            f_reckon_table(j, 9) = rs1.Fields(9).Value
            j = j + 1
            rs1.MoveNext
            List1.ListIndex = 0
        Wend
    Next
    f_current_row = 0
    SQL = "select * from 欠款收回表 where 帐单号 = " & _
    "'" & f_reckon_table(f_current_row, 5) & "'" & " and 帐本号= " & "'" & f_reckon_table(f_current_row, 4) & "'"
    With cmd1
        .ActiveConnection = cnn1
        .CommandText = SQL
        .CommandType = adCmdText
    End With
    Set rs1 = cmd1.Execute
    If rs1.EOF Then
        cnn1.Close
        Set cnn1 = Nothing
        GoTo exit_list3_getfocus
    End If
    j = 0
    List2.Clear
    rs1.MoveFirst
    While Not rs1.EOF
        S = ""
        For i = 0 To rs1.Fields.Count - 1
            Select Case i
                Case 3
                    date_string = Round(rs1.Fields(2).Value, 0) & "年" & _
                    Round(rs1.Fields(4).Value, 0) & "月" & _
                    Round(rs1.Fields(5).Value, 0) & "日"
                    t_len = 14 - Len(date_string)
                    S1 = ""
                    For t = 1 To t_len
                        S1 = S1 & " "
                    Next
                    S = S & date_string & S1
                Case 6
                    t_len = 0
                    t_value = Round(rs1.Fields(i).Value, 2)
                    t_len = 11 - Len(t_value)
                    S1 = ""
                    If t_value = Int(t_value) Then
                        S1 = S1 & ".00"
                        t_len = t_len - 3
                    Else
                        If (t_value * 10) = Int(t_value * 10) Then
                            S1 = S1 & "0"
                            t_len = t_len - 1
                        End If
                    End If
                    For t = 1 To t_len
                        S1 = S1 & " "
                    Next
                    S = S & t_value & S1
                Case Else
            End Select
        Next
        List2.AddItem S, j
        f_repay_table(j, 0) = rs1.Fields(0).Value
        f_repay_table(j, 1) = rs1.Fields(1).Value
        f_repay_table(j, 2) = rs1.Fields(2).Value
        f_repay_table(j, 3) = rs1.Fields(3).Value
        f_repay_table(j, 4) = rs1.Fields(4).Value
        f_repay_table(j, 5) = rs1.Fields(5).Value
        f_repay_table(j, 6) = rs1.Fields(6).Value
        j = j + 1
        rs1.MoveNext
        List2.ListIndex = 0
    Wend
    cnn1.Close
    Set cnn1 = Nothing
exit_list3_getfocus:
End Sub