form28.frm

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

                    Next
                    S = S & rs1.Fields(i).Value & S1
                Case 6
                    t_len = 0
                    t_len = 11 - Len(rs1.Fields(i).Value)
                    S1 = ""
                    For t = 1 To t_len
                        S1 = S1 & " "
                    Next
                    S = S & rs1.Fields(i).Value & S1
                Case 7
                    t_len = 0
                    t_value = Round(rs1.Fields(i).Value, 3)
                    t_len = 11 - Len(t_value)
                    
                    S1 = ""
                    If t_value = Int(t_value) Then
                        S1 = S1 & ".000"
                        t_len = t_len - 4
                    Else
                        If (t_value * 10) = Int(t_value * 10) Then
                            S1 = S1 & "00"
                            t_len = t_len - 2
                        Else
                            If (t_value * 100) = Int(t_value * 100) Then
                                S1 = S1 & "0"
                                t_len = t_len - 1
                            End If
                        End If
                    End If
                    If t_value < 1 And t_value > 0 Then
                        S = S & "0"
                        t_len = t_len - 1
                    End If
                    
                    For t = 1 To t_len
                        S1 = S1 & " "
                    Next
                    
                    S = S & t_value & S1
                Case 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 Else
            End Select
        Next
        List3.AddItem S, j
        f_arr_number(j) = rs1.Fields(0)
        Text1.Text = Text1.Text + rs1.Fields(8)
        j = j + 1
        rs1.MoveNext
        List3.ListIndex = 0
    Wend

    Text1.Text = Round(Text1.Text, 2)
    Text2.Text = f_reckoning_table(f_current_row, 6)
    Text3.Text = f_reckoning_table(f_current_row, 9)
    cnn1.Close
    Set cnn1 = Nothing
exit_Command1_Click:
End Sub

Private Sub Command10_Click()
    If List4.ListCount > 0 Then
        For j = List4.ListIndex To List4.ListCount - 2
            List4.List(j) = List4.List(j + 1)
        Next
        List4.RemoveItem (List4.ListCount - 1)
        List4.ListIndex = 0
    Else
        MsgBox ("没有数据")
    End If
End Sub

Private Sub Command2_Click()
    If List1.ListCount = 0 Then
        MsgBox ("没有对应帐单数据")
        GoSub exit_command2_click
    End If
    Printer.FontSize = 13
    Printer.FontName = "黑体"
    Printer.Print Chr(vbKeyReturn)
    doc = Space(3) & "帐本号          " & "帐单号          " & "金  额     " & "制单日期"
    Printer.Print doc
    doc = "----------------------------------------------------------------------------------------"
    Printer.Print doc
    t_row_count = List1.ListCount
    For i = 0 To t_row_count - 1
        S = ""
        tt_len = Len(f_reckoning_table(i, 4))
        t_len = 0
        For t = 1 To tt_len
            If Asc((Mid(f_reckoning_table(i, 4), t, 1))) < 0 Then
                t_len = t_len + 2
            Else
                t_len = t_len + 1
            End If
        Next
        t_len = 16 - t_len
        S1 = ""
        For t = 1 To t_len
            S1 = S1 & " "
        Next
        S = S & f_reckoning_table(i, 4) & S1
        
        tt_len = Len(f_reckoning_table(i, 5))
        t_len = 0
        For t = 1 To tt_len
            If Asc((Mid(f_reckoning_table(i, 5), t, 1))) < 0 Then
                t_len = t_len + 2
            Else
                t_len = t_len + 1
            End If
        Next
        t_len = 16 - t_len
        S1 = ""
        For t = 1 To t_len
            S1 = S1 & " "
        Next
        S = S & f_reckoning_table(i, 5) & S1
        
        t_len = 0
        t_value = Round(f_reckoning_table(i, 6), 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
        
        date_string = Round(f_reckoning_table(i, 1), 0) & "年" & _
        Round(f_reckoning_table(i, 2), 0) & "月" & _
        Round(f_reckoning_table(i, 3), 0) & "日"
        t_len = 14 - Len(date_string)
        S1 = ""
        For t = 1 To t_len
            S1 = S1 & " "
        Next
        S = S & date_string & S1
        
        Printer.FontSize = 13
        doc = Space(3) & S
        Printer.Print doc
        Printer.FontSize = 3
        Printer.Print Chr(vbKeyReturn)
        doc = "---------------------------------------------------------------------------------------------------------" & _
        "-------------------------------------------------------------------------------------------------------------" & _
        "-------------------------------------------------------------------------------------------------------------"
        Printer.Print doc
    Next
    Printer.EndDoc
exit_command2_click:
End Sub

Private Sub Command3_Click()
    If List1.ListCount = 0 Then
        MsgBox ("没有对应帐单数据")
        GoSub exit_command3_click
    End If
    g_current_number = f_reckoning_table(f_current_row, 0)
    f_formshow = "NO"
    Unload Form28
    Form34.Show
exit_command3_click:
End Sub

Private Sub Command4_Click()
    If List4.ListCount = 0 Then
        MsgBox ("没有对应帐单数据")
        GoSub exit_command_click
    End If
    Printer.FontSize = 13
    Printer.FontName = "黑体"
    Dim cnn1 As ADODB.Connection
    Dim cmd1 As ADODB.Command
    Dim rs1 As ADODB.Recordset
    Dim rs2 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
    Dim t_sell_table1(20, 4), t_sell_table2(20, 4)
    page_row = 0
    For i = 0 To List4.ListCount - 1
        j = 0
        continue_loop = True
        While j <= List1.ListCount - 1 And continue_loop = True
            If List4.List(i) = f_reckoning_table(j, 4) Then
                t_date = Round(f_reckoning_table(j, 1), 0) & "." & _
                        Round(f_reckoning_table(j, 2), 0) & "." & _
                        Round(f_reckoning_table(j, 3), 0)
                doc = "本:" & f_reckoning_table(j, 4) & Space(6 - Len(f_reckoning_table(j, 4))) & _
                " 单:" & f_reckoning_table(j, 5) & Space(7 - Len(f_reckoning_table(j, 5))) & _
                " 日期:" & RTrim(t_date) & Space(10 - Len(RTrim(t_date))) & "|   "
                SQL = "select * from 品种售出表 where 单号 = " & _
                "'" & f_reckoning_table(j, 5) & "'" & " and 帐本号= " & "'" & _
                f_reckoning_table(j, 4) & "'" & " order by 品种"
                With cmd1
                    .ActiveConnection = cnn1
                    .CommandText = SQL
                    .CommandType = adCmdText
                End With
                Set rs1 = cmd1.Execute
                If Not rs1.EOF Then
                    rs1.MoveFirst
                End If
                Row = 0
                While Not rs1.EOF
                    t_sell_table1(Row, 0) = rs1.Fields(1).Value
                    t_sell_table1(Row, 1) = rs1.Fields(6).Value
                    t_sell_table1(Row, 2) = rs1.Fields(7).Value
                    t_sell_table1(Row, 3) = rs1.Fields(8).Value
                    Row = Row + 1
                    rs1.MoveNext
                Wend
                max_row1 = Row - 1
                k = j + 1
                max_row2 = -1
                For j1 = k To List1.ListCount - 1
                    If List4.List(i) = f_reckoning_table(j1, 4) Then
                        t_date = Round(f_reckoning_table(j1, 1), 0) & "." & _
                                Round(f_reckoning_table(j1, 2), 0) & "." & _
                                Round(f_reckoning_table(j1, 3), 0)
                        doc = doc & "本:" & f_reckoning_table(j1, 4) & Space(6 - Len(f_reckoning_table(j, 4))) & _
                        " 单:" & f_reckoning_table(j1, 5) & Space(7 - Len(f_reckoning_table(j, 5))) & _
                        " 日期:" & t_date
                        SQL = "select * from 品种售出表 where 单号 = " & _
                        "'" & f_reckoning_table(j1, 5) & "'" & " and 帐本号= " & "'" & _
                        f_reckoning_table(j1, 4) & "'" & " order by 品种"
                        With cmd1
                            .ActiveConnection = cnn1
                            .CommandText = SQL
                            .CommandType = adCmdText
                        End With
                        Set rs1 = cmd1.Execute
                        If Not rs1.EOF Then
                            rs1.MoveFirst
                        End If
                        Row = 0
                        While Not rs1.EOF
                            t_sell_table2(Row, 0) = rs1.Fields(1)
                            t_sell_table2(Row, 1) = rs1.Fields(6)
                            t_sell_table2(Row, 2) = rs1.Fields(7)
                            t_sell_table2(Row, 3) = rs1.Fields(8)
                            Row = Row + 1
                            rs1.MoveNext
                        Wend
                        max_row2 = Row - 1
                        j = j1 + 1
                        GoTo exit_loop
                    End If
                Next
                continue_loop = False
exit_loop:
                If max_row1 >= max_row2 Then
                    For Row = max_row2 + 1 To max_row1
                        t_sell_table2(Row, 0) = " "
                        t_sell_table2(Row, 1) = " "
                        t_sell_table2(Row, 2) = " "
                        t_sell_table2(Row, 3) = " "
                    Next
                    max_row = max_row1
                Else
                    For Row = max_row1 + 1 To max_row2
                        t_sell_table1(Row, 0) = " "
                        t_sell_table1(Row, 1) = " "
                        t_sell_table1(Row, 2) = " "
                        t_sell_table1(Row, 3) = " "
                    Next
                    max_row = max_row2
                End If
                
                If page_row + 3 + max_row > 44 Then
                    page_row = 0
                    Printer.NewPage
                End If
                Printer.Print doc
                Printer.Print Space(40) & "|"
                For Row = 0 To max_row
                    S = ""
                    tt_len = Len(t_sell_table1(Row, 0))
                    t_len = 0
                    For t = 1 To tt_len
                            If Asc((Mid((t_sell_table1(Row, 0)), t, 1))) < 0 Then
                                t_len = t_len + 2
                            Else
                                t_len = t_len + 1
                            End If
                    Next
                    t_len = 14 - t_len
                    S1 = ""
                    For t = 1 To t_len
                        S1 = S1 & " "
                    Next
                    S = S & t_sell_table1(Row, 0) & S1
                    '斤数
                    t_len = 0
                    t_len = 8 - Len(t_sell_table1(Row, 1))
                    S1 = ""
                    For t = 1 To t_len
                        S1 = S1 & " "
                    Next
                    S = S & t_sell_table1(Row, 1) & S1
                    '单价
                    If t_sell_table1(Row, 2) <> " " Then
                        t_len = 0
                        t_value = Round(t_sell_table1(Row, 2), 3)
                        t_len = 8 - Len(t_value)
                        S1 = ""
                        If t_value = Int(t_value) Then
                            S1 = S1 & ".000"
                            t_len = t_len - 4
                        Else
                            If (t_value * 10) = Int(t_value * 10) Then
                                S1 = S1 & "00"
                                t_len = t_len - 2
                            Else
                                If (t_value * 100) = Int(t_value * 100) Then
                                    S1 = S1 & "0"
                                    t_len = t_len - 1
                                End If
                            End If
                        End If
                        If t_value < 1 And t_value > 0 Then
                            S = S & "0"
                            t_len = t_len - 1
                        End If
                        For t = 1 To t_len
                            S1 = S1 & " "
                        Next
                        S = S & t_value & S1
                    Else
                        S = S & Space(8)
                    End If
                    '金额
                    If t_sell_table1(Row, 3) <> " " Then
                        t_len = 0
                        t_value = Round(t_sell_table1(Row, 3), 2)
                        t_len = 8 - 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