form23.frm

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

VERSION 5.00
Begin VB.Form Form23 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Form23"
   ClientHeight    =   8325
   ClientLeft      =   45
   ClientTop       =   435
   ClientWidth     =   13650
   LinkTopic       =   "Form23"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   8325
   ScaleWidth      =   13650
   StartUpPosition =   3  '窗口缺省
   Begin VB.CommandButton Command3 
      Caption         =   "数据转出"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   420
      Left            =   7320
      TabIndex        =   5
      Top             =   7680
      Width           =   1335
   End
   Begin VB.ListBox List1 
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   6300
      ItemData        =   "Form23.frx":0000
      Left            =   240
      List            =   "Form23.frx":0002
      TabIndex        =   2
      Top             =   1080
      Width           =   13095
   End
   Begin VB.CommandButton Command1 
      Caption         =   "确认删除"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   420
      Left            =   4560
      TabIndex        =   1
      Top             =   7680
      Width           =   1335
   End
   Begin VB.CommandButton Command2 
      Caption         =   "修改数据"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   420
      Left            =   5880
      TabIndex        =   0
      Top             =   7680
      Width           =   1455
   End
   Begin VB.Label Label1 
      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            =   240
      TabIndex        =   4
      Top             =   765
      Width           =   12840
   End
   Begin VB.Label Label2 
      AutoSize        =   -1  'True
      Caption         =   "品种寄售明细查询"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   15.75
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   315
      Left            =   5520
      TabIndex        =   3
      Top             =   240
      Width           =   2520
   End
End
Attribute VB_Name = "Form23"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim arr_number(100), m_max_number
Private Sub Command1_Click()
    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 编号=" & arr_number(List1.ListIndex)
    With cmd1
        .ActiveConnection = cnn1
        .CommandText = SQL
        .CommandType = adCmdText
        .Execute
    End With
    SQL = "select 编号,品种 ,年份 ,月份 ,日期 ,单号 ," & _
           "购入斤数 ,购入单价,购入金额,运费,卸车费  from 品种寄售表 where " & _
          "品种= " & "'" & m_breed & "'" & " and 年份 = " & m_year & "and 月份=" & m_month
    With cmd1
        .ActiveConnection = cnn1
        .CommandText = SQL
        .CommandType = adCmdText
    End With
    Set rs1 = cmd1.Execute
    j = 0
    List1.Clear
    If rs1.EOF Then
        MsgBox ("没有查询到记录")
        Command1.Enabled = False
        Command2.Enabled = False
        Command3.Enabled = False
        GoSub m_exit
    End If
    rs1.MoveFirst
    While Not rs1.EOF
        S = ""
        For i = 1 To rs1.Fields.Count - 1
            If i = 1 Or i = 5 Then
                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 = 11 - t_len
            Else
                t_len = 11 - Len(rs1.Fields(i).Value)
            End If
            S1 = ""
            For t = 1 To t_len
                S1 = S1 & " "
            Next
            S = S & rs1.Fields(i).Value & S1
        Next
        List1.AddItem S, j
        arr_number(j) = rs1.Fields(0).Value
        j = j + 1
        rs1.MoveNext
    Wend
    List1.ListIndex = 0
m_exit:
    cnn1.Close
    Set cnn1 = Nothing
End Sub

Private Sub Command2_Click()
    m_current_number = arr_number(List1.ListIndex)
    Form22.Show
    unload_mark = 1
    Unload Form23
End Sub

Private Sub Command3_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
    SQL = "select max(编号) from 品种购入表 "
    With cmd1
        .ActiveConnection = cnn1
        .CommandText = SQL
        .CommandType = adCmdText
    End With
    Set rs1 = cmd1.Execute
    rs1.MoveFirst
    m_max_number = rs1.Fields(0) + 1
    SQL = "select  编号,品种, 年份,月份,日期,单号,购入斤数,购入单价,购入金额,运费,卸车费 from 品种寄售表 where 编号=" & arr_number(List1.ListIndex)
    With cmd1
        .ActiveConnection = cnn1
        .CommandText = SQL
        .CommandType = adCmdText
    End With
    Set rs1 = cmd1.Execute
    rs1.MoveFirst
    SQL = "INSERT INTO 品种购入表(编号,品种, 年份,月份,日期,单号,购入斤数,购入单价," & _
          "购入金额,运费,卸车费) VALUES ( " & m_max_number & "," & " '" & rs1.Fields(1) & "'" & "," & _
          rs1.Fields(2) & "," & rs1.Fields(3) & "," & rs1.Fields(4) & ",'" & rs1.Fields(5) & _
          "'" & "," & rs1.Fields(6) & "," & rs1.Fields(7) & "," & rs1.Fields(8) & _
          "," & rs1.Fields(9) & "," & rs1.Fields(10) & ")"
    With cmd1
        .ActiveConnection = cnn1
        .CommandText = SQL
        .CommandType = adCmdText
        .Execute
    End With
    SQL = "delete * from 品种寄售表 where 编号=" & arr_number(List1.ListIndex)
    With cmd1
        .ActiveConnection = cnn1
        .CommandText = SQL
        .CommandType = adCmdText
        .Execute
    End With
    MsgBox ("数据转出成功!")
    SQL = "select 编号,品种 ,年份 ,月份 ,日期 ,单号 ," & _
           "购入斤数 ,购入单价,购入金额,运费,卸车费  from 品种寄售表 where " & _
          "品种= " & "'" & m_breed & "'" & " and 年份 = " & m_year & "and 月份=" & m_month
    With cmd1
        .ActiveConnection = cnn1
        .CommandText = SQL
        .CommandType = adCmdText
    End With
    Set rs1 = cmd1.Execute
    j = 0
    List1.Clear
    If rs1.EOF Then
        MsgBox ("没有查询到记录")
        Command1.Enabled = False
        Command2.Enabled = False
        Command3.Enabled = False
        GoSub m_exit
    End If
    rs1.MoveFirst
    While Not rs1.EOF
        S = ""
        For i = 1 To rs1.Fields.Count - 1
            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
        Next
        List1.AddItem S, j
        arr_number(j) = rs1.Fields(0).Value
        j = j + 1
        rs1.MoveNext
    Wend
    List1.ListIndex = 0
m_exit:
    cnn1.Close
    Set cnn1 = Nothing
End Sub

Private Sub Form_Load()
    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 = "select 编号,品种 ,年份 ,月份 ,日期 ,单号 ," & _
           "购入斤数 ,购入单价,购入金额,运费,卸车费  from 品种寄售表 where " & _
          "品种 = " & "'" & m_breed & "'" & "and 年份 = " & m_year & "and 月份=" & m_month
    With cmd1
        .ActiveConnection = cnn1
        .CommandText = SQL
        .CommandType = adCmdText
    End With
    Set rs1 = cmd1.Execute
    j = 0
    If rs1.EOF Then
        MsgBox ("没有查询到记录")
        Command1.Enabled = False
        Command2.Enabled = False
        Command3.Enabled = False
        GoSub m_exit
    End If
    rs1.MoveFirst
    While Not rs1.EOF
        S = ""
        For i = 1 To rs1.Fields.Count - 1
            If i = 1 Or i = 5 Then
                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 = 11 - t_len
            Else
                t_len = 11 - Len(rs1.Fields(i).Value)
            End If
            S1 = ""
            For t = 1 To t_len
                S1 = S1 & " "
            Next
            S = S & rs1.Fields(i).Value & S1
        Next
        List1.AddItem S, j
        arr_number(j) = rs1.Fields(0).Value
        j = j + 1
        rs1.MoveNext
    Wend
    List1.ListIndex = 0
m_exit:
    cnn1.Close
    Set cnn1 = Nothing
    unload_mark = 0
End Sub

Private Sub Form_Unload(Cancel As Integer)
    If unload_mark = 0 Then
        Form5.Show
    End If
End Sub