form28.frm

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

                        End If
                        For t = 1 To t_len
                            S1 = S1 & " "
                        Next
                        S = S & t_value & S1
                    Else
                        S = S & Space(8)
                    End If
                    
                    '第二笔
                    S = S & Space(2) & "|" & Space(3)
                    '品名
                    tt_len = Len(t_sell_table2(Row, 0))
                    t_len = 0
                    For t = 1 To tt_len
                            If Asc((Mid((t_sell_table2(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_table2(Row, 0) & S1
                    '斤数
                    t_len = 0
                    t_len = 8 - Len(t_sell_table2(Row, 1))
                    S1 = ""
                    For t = 1 To t_len
                        S1 = S1 & " "
                    Next
                    S = S & t_sell_table2(Row, 1) & S1
                    '单价
                    If t_sell_table2(Row, 2) <> " " Then
                        t_len = 0
                        t_value = Round(t_sell_table2(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_table2(Row, 3) <> " " Then
                        t_len = 0
                        t_value = Round(t_sell_table2(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
                        End If
                        For t = 1 To t_len
                            S1 = S1 & " "
                        Next
                        S = S & t_value & S1
                    Else
                        S = S & Space(8)
                    End If
                    Printer.Print S
                Next
                Printer.Print "---------------------------------------------------------------------------------------------------------"
                page_row = page_row + 2 + max_row
            Else
                j = j + 1
            End If
        Wend
    Next
    Printer.EndDoc
    cnn1.Close
    Set cnn1 = Nothing
exit_command_click:
End Sub

Private Sub Command5_Click()
    t_YesNo = MsgBox("是否确认删除", vbYesNo)
    If t_YesNo = 7 Then
        GoSub exit_command5_click
    End If
    If List3.ListCount = 0 Then
        MsgBox ("没有对应售出明细数据")
        GoSub exit_command5_click
    End If
    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
    SQL = "delete from 品种售出表 where 编号=" & f_arr_number(List3.ListIndex)
    With cmd1
        .ActiveConnection = cnn1
        .CommandText = SQL
        .CommandType = adCmdText
        .Execute
    End With
    List3.Clear
    SQL = "select * from 品种售出表 where 单号 = " & _
    "'" & f_reckoning_table(f_current_row, 5) & "'" & " and 帐本号= " & "'" & f_reckoning_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
        Text1.Text = 0
        Text2.Text = f_reckoning_table(f_current_row, 6)
        Text3.Text = f_reckoning_table(f_current_row, 9)
        GoTo exit_command5_click
    End If
    j = 0
    Text1.Text = 0
    rs1.MoveFirst
    While Not rs1.EOF
        S = ""
        For i = 0 To rs1.Fields.Count - 1
            Select Case i
                Case 1
                    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 = 18 - t_len
                    S1 = ""
                    For t = 1 To t_len
                        S1 = S1 & " "
                    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_command5_click:
End Sub

Private Sub Command6_Click()
    If List3.ListCount = 0 Then
        MsgBox ("没有对应售出明细数据")
        GoSub exit_command6_click
    End If
    g_current_number = f_arr_number(List3.ListIndex)
    MsgBox (g_current_number)
    g_form = "form28"
    Form21.Show
    f_formshow = "NO"
    Unload Form28
exit_command6_click:
End Sub

Private Sub Command7_Click()
    g_reckoning = f_reckoning_table(f_current_row, 5)
    g_book = f_reckoning_table(f_current_row, 4)
    f_formshow = "NO"
    g_form = "form28"
    Unload Form28
    Form4.Show
End Sub

Private Sub Command8_Click()
    g_year = f_reckoning_table(f_current_row, 1)
    g_book = f_reckoning_table(f_current_row, 4)
    g_reckoning = f_reckoning_table(f_current_row, 5)
    f_formshow = "NO"
    g_form = "form28"
    Unload Form28
    Form42.Show
End Sub

Private Sub Command9_Click()
    t_YesNo = MsgBox("是否确认删除", vbYesNo)
    If t_YesNo = 7 Then
        GoSub exit_command9_click
    End If
    If List2.ListCount = 0 Then
        MsgBox ("没有对应帐单品种数据")
        GoSub exit_command9_click
    End If
    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
    SQL = "delete from 帐单品种表 where 编号=" & f_arr_number1(List2.ListIndex)
    With cmd1
        .ActiveConnection = cnn1
        .CommandText = SQL
        .CommandType = adCmdText
        .Execute
    End With
    List2.Clear
    SQL = "select 编号,品种 from 帐单品种表 where 帐单号 = " & _
    "'" & f_reckoning_table(f_current_row, 5) & "'" & " and 帐本号= " & "'" & _
     f_reckoning_table(f_current_row, 4) & "'" & " order by 品种"
    With cmd1
        .ActiveConnection = cnn1
        .CommandText = SQL
        .CommandType = adCmdText
    End With
    Set rs1 = cmd1.Execute
    j = 0
    If Not rs1.EOF Then
        rs1.MoveFirst
    End If
    While Not rs1.EOF
        S = ""
        For i = 0 To rs1.Fields.Count - 1
            Select Case i
                Case 1
                    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 = 18 - t_len
                    S1 = ""
                    For t = 1 To t_len
                        S1 = S1 & " "
                    Next
                    S = S & rs1.Fields(i).Value & S1
            End Select
        Next
        List2.AddItem S, j
        f_arr_number1(j) = rs1.Fields(0)
        List2.ListIndex = 0
        j = j + 1
        rs1.MoveNext
    Wend
    cnn1.Close
    Set cnn1 = Nothing
exit_command9_click:
End Sub

Private Sub Form_Load()
    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
    f_formshow = "OK"
    Select Case g_form
        Case "form5", "form27"
            g_previous_form = g_form
    End Select
    cnn1.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
    "Data Source=C:\Documents and Settings\jujumao\My Documents\粤丰饲料\粤丰饲料经营情况.mdb;"
    Set cmd1 = New ADODB.Command
    Select Case g_query_method
        Case 1
            SQL = "select * from 帐单表  where 年份 =" & g_year & _
            " and 月份 = " & g_month & " and 帐本号 = " & "'" & g_book & "'" & " order by 编号 "
        Case 2
            SQL = "select * from 帐单表  where 年份 =" & g_year & _
            " and 月份 = " & g_month & " and 帐单号 = " & "'" & g_reckoning & "'" & " order by 编号 "
        Case 3, 4
            SQL = "select * from 帐单表  where 年份 =" & g_year & _
            " and 月份 = " & g_month & " order by 帐本号,编号 "
    End Select
    With cmd1
        .ActiveConnection = cnn1
        .CommandText = SQL