form28.frm

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

         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   405
      Left            =   4920
      TabIndex        =   7
      Top             =   5850
      Width           =   1215
   End
   Begin VB.Label Label1 
      Caption         =   "电脑合计："
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   405
      Left            =   1560
      TabIndex        =   5
      Top             =   5880
      Width           =   1215
   End
   Begin VB.Label Label4 
      AutoSize        =   -1  'True
      Caption         =   "品种            售出斤数    售出单价    售出金额"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   240
      Left            =   6120
      TabIndex        =   3
      Top             =   600
      Width           =   5760
   End
   Begin VB.Label Label3 
      AutoSize        =   -1  'True
      Caption         =   "  单据号   "
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   240
      Left            =   2040
      TabIndex        =   2
      Top             =   600
      Width           =   1080
   End
   Begin VB.Label Label2 
      AutoSize        =   -1  'True
      Caption         =   " 本号"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   240
      Left            =   120
      TabIndex        =   1
      Top             =   600
      Width           =   600
   End
End
Attribute VB_Name = "Form28"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim f_reckoning_table(500, 10), f_arr_number(500), f_arr_number1(20)
Dim f_formshow, f_current_row, f_all


Private Sub Combo1_Click()
    If Combo1.Text = "全 部" Then
        f_all = True
        List4.Clear
        For i = 0 To Combo1.ListCount - 1
            j = 0
            If Combo1.List(i) <> "全 部" Then
                List4.AddItem Combo1.List(i), j
                j = j + 1
            End If
        Next
    Else
        If f_all = True Then
            List4.Clear
            f_all = False
        End If
        For i = 0 To List4.ListCount - 1
            If List4.List(i) = Combo1.Text Then
                GoSub exit_combo1_click
            End If
        Next
        List4.AddItem Combo1.Text, List4.ListCount
    End If
    List4.ListIndex = 0
exit_combo1_click:
End Sub

Private Sub Command1_Click()
    t_YesNo = MsgBox("是否确认删除", vbYesNo)
    If t_YesNo = 7 Then
        GoSub exit_Command1_Click
    End If
    If List1.ListCount = 0 Then
        MsgBox ("没有对应帐单数据")
        GoSub exit_Command1_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 = "select count(*) 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
    rs1.MoveFirst
    If rs1.Fields(0) > 0 Then
        MsgBox ("购入明细有数据!不能删除")
        cnn1.Close
        Set cnn1 = Nothing
        GoSub exit_Command1_Click
    End If
    SQL = "select count(*) 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
    rs1.MoveFirst
    If rs1.Fields(0) > 0 Then
        MsgBox ("购入明细有数据!不能删除")
        cnn1.Close
        Set cnn1 = Nothing
        GoSub exit_Command1_Click
    End If
    SQL = "select count(*) 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
    rs1.MoveFirst
    If rs1.Fields(0) > 0 Then
        MsgBox ("购入明细有数据!不能删除")
        cnn1.Close
        Set cnn1 = Nothing
        GoSub exit_Command1_Click
    End If
    SQL = "delete from 帐单表 where 编号=" & f_reckoning_table(f_current_row, 0)
    With cmd1
        .ActiveConnection = cnn1
        .CommandText = SQL
        .CommandType = adCmdText
        .Execute
    End With
    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
        .CommandType = adCmdText
    End With
    Set rs1 = cmd1.Execute
    List1.Clear
    If rs1.EOF Then
        MsgBox ("没有查询到数据!")
        GoSub exit_Command1_Click
    End If
    j = 0
    rs1.MoveFirst
    While Not rs1.EOF
        If g_query_method = 4 Then
            SQL = "select 品种,售出金额 from 品种售出表 where 帐本号=" & "'" & _
            rs1.Fields(4) & "'" & " and 单号=" & "'" & rs1.Fields(5) & "'" & _
            " order by 品种"
            With cmd1
                .ActiveConnection = cnn1
                .CommandText = SQL
                .CommandType = adCmdText
            End With
            Set rs2 = cmd1.Execute
            S1 = ""
            t_SumSell = 0
            If Not rs2.EOF Then
                rs2.MoveFirst
                While Not rs2.EOF
                    S1 = S1 & rs2.Fields(0)
                    t_SumSell = t_SumSell + rs2.Fields(1)
                    rs2.MoveNext
                Wend
            End If
            
            SQL = "select 品种 from 帐单品种表 where 帐本号=" & "'" & _
            rs1.Fields(4) & "'" & " and 帐单号=" & "'" & rs1.Fields(5) & "'" & _
            " order by 品种"
            With cmd1
                .ActiveConnection = cnn1
                .CommandText = SQL
                .CommandType = adCmdText
            End With
            Set rs2 = cmd1.Execute
            S2 = ""
            If Not rs2.EOF Then
                rs2.MoveFirst
                While Not rs2.EOF
                    S2 = S2 & rs2.Fields(0)
                    rs2.MoveNext
                Wend
            End If
            If Round(t_SumSell, 2) = Round(rs1.Fields(6), 2) And S1 = S2 Then
                    rs1.MoveNext
                    GoTo exit_command1_click_while
            End If
        End If

        S = ""
        For i = 0 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 = 16 - t_len
                    S1 = ""
                    For t = 1 To t_len
                        S1 = S1 & " "
                    Next
                    S = S & rs1.Fields(i).Value & S1
            End Select
            f_reckoning_table(j, i) = rs1.Fields(i).Value
        Next
        List1.AddItem S, j
        j = j + 1
        rs1.MoveNext
exit_command1_click_while:
    Wend
    If j = 0 And g_query_method = 4 Then
        MsgBox ("没有查询到数据!")
        GoSub exit_Command1_Click
    End If
    List1.ListIndex = 0
    f_current_row = 0
    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)
        j = j + 1
        rs1.MoveNext
    Wend
    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
        MsgBox ("没有对应的售出明细数据!")
        cnn1.Close
        Set cnn1 = Nothing
        Text1.Text = 0
        Text2.Text = f_reckoning_table(f_current_row, 6)
        GoTo exit_Command1_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 & " "