frmpschk.frm

里面的内容包括：基盘存管理本信息管理库存管理入库管理出库管理等功能

VERSION 5.00
Begin VB.Form FrmPsChk 
   Caption         =   "入库单审核"
   ClientHeight    =   4590
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   7020
   Icon            =   "FrmPsChk.frx":0000
   LinkTopic       =   "Form1"
   ScaleHeight     =   4590
   ScaleWidth      =   7020
   StartUpPosition =   1  '所有者中心
   Begin VB.CommandButton CmdCheck 
      Caption         =   "全部放弃(&U)"
      Height          =   375
      Index           =   1
      Left            =   5280
      TabIndex        =   6
      Top             =   1980
      Width           =   1635
   End
   Begin VB.CommandButton CmdCheck 
      Caption         =   "全部选中(&A)"
      Height          =   375
      Index           =   0
      Left            =   5100
      TabIndex        =   5
      Top             =   1200
      Width           =   1635
   End
   Begin VB.CommandButton CmdCheck 
      Caption         =   "退出(&X)"
      Height          =   375
      Index           =   3
      Left            =   5280
      TabIndex        =   4
      Top             =   3600
      Width           =   1635
   End
   Begin VB.CommandButton CmdCheck 
      Caption         =   "审核过帐(&C)"
      Height          =   375
      Index           =   2
      Left            =   5160
      TabIndex        =   3
      Top             =   2760
      Width           =   1635
   End
   Begin VB.ListBox LstDJ 
      Height          =   3420
      ItemData        =   "FrmPsChk.frx":0442
      Left            =   60
      List            =   "FrmPsChk.frx":0444
      Style           =   1  'Checkbox
      TabIndex        =   0
      Top             =   840
      Width           =   4755
   End
   Begin VB.Label LblCap 
      Caption         =   "单据编号                       日期"
      Height          =   195
      Index           =   1
      Left            =   300
      TabIndex        =   2
      Top             =   540
      Width           =   4395
   End
   Begin VB.Label LblCap 
      Caption         =   "请先选中将要审核过帐的单据，然后点击“审核过帐”按钮"
      Height          =   195
      Index           =   0
      Left            =   60
      TabIndex        =   1
      Top             =   180
      Width           =   5235
   End
End
Attribute VB_Name = "FrmPsChk"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private rsPSChk As ADODB.Recordset
Private cmPSChk As ADODB.Command
Private rsMHQP As ADODB.Recordset
Private rsMAT_HEAD As ADODB.Recordset

Private Sub CmdCheck_Click(Index As Integer)
    Dim intCur As Integer
    Select Case Index
        Case 0
            '单击了“全部选中”命令按钮，依次选中所有的入库单编号
            For intCur = 0 To LstDJ.ListCount - 1
                '判断当前的列表项是否被选中
                If LstDJ.Selected(intCur) = False Then
                    '当前的列表项没有被选中，选中当前的列表项
                    LstDJ.Selected(intCur) = True
                End If
            Next
        Case 1
            '单击了“全部不选中”命令按钮，依次不选中所有的入库单编号
            For intCur = 0 To LstDJ.ListCount - 1
                '判断当前的列表项是否被选中
                If LstDJ.Selected(intCur) = True Then
                    '当前的列表项被选中，不选中当前的列表项
                    LstDJ.Selected(intCur) = False
                End If
            Next
        Case 2
             '单击了“审核过账”命令按钮，调用PSCheck过程完成选中入库
             '单单据的审核过账工作
            Call PSCheck
            '从列表框中，依次删除已经审核过账的入库单编号
            For intCur = LstDJ.ListCount - 1 To 0 Step -1
                '判断当前的列表项是否被选中
                If LstDJ.Selected(intCur) = True Then
                    '当前的列表项被选中，从列表框中选出该表项
                    LstDJ.RemoveItem intCur
                End If
            Next
            '弹出提示框，提示“审核过账完毕”
            MsgBox "审核过帐完毕!", , "审核过帐"
        Case 3
             '单击了“退出”命令按钮，退出该入库单审核模块
            Unload Me
    End Select
End Sub

Private Sub Form_Load()
    Dim strItem As String
    '在变量中存在当前窗体的句柄
    intNumWindows = OpenWindow(intNumWindows)
    '设置入库审核模块的宽度和高度
    Me.Height = 4995
    Me.Width = 7140
    Call SetFormStu(Me, frmMain)
    '设置数据集对象rsPSChk为数据环境中的rsComPsHA数据集
    Set rsPSChk = DEjxc.rsComPsHA
    '打开数据集对象rsPSChk
    rsPSChk.Open
    '初始化对应于数据集对象rsMHQP、rsMAT_HEAD和命令对象cmPSChk
    Set rsMHQP = New ADODB.Recordset
    Set cmPSChk = New ADODB.Command
    Set rsMAT_HEAD = New ADODB.Recordset
    '设置命令对象cmPSChk的数据库连接和命令类型
    cmPSChk.ActiveConnection = DEjxc.Conjxc
    cmPSChk.CommandType = adCmdText
    With rsPSChk
         '判断数据集对象rsPSChk中的记录数是否为0，即入库单单据简单
         '信息表中是否存在记录
        If .RecordCount <> 0 Then
            '数据集对象rsPSChk中的记录数为0，移动记录位置到首部
            .MoveFirst
            '在ListBox控件中显示入库单单据简单信息表中所有记录的入库单
            '编号和日期
            While Not .EOF
                strItem = !PS_id & Space(20) & !PS_date
                '利用ListBox控件的AddItem方法，在ListBox控件中添加一条
                '入库单单据简单信息表中记录的入库单编号和日期
                LstDJ.AddItem strItem
                '移动记录位置到下一条
                .MoveNext
            Wend
        End If
    End With
End Sub

Private Sub PSCheck()
    Dim strSQL As String
    Dim intCur As Integer
    Dim strPSID As String
    '依次审核结帐选中的所有入库单编号对应的入库单简单信息和详细信息
    For intCur = 0 To LstDJ.ListCount - 1
        '判断ListBox控件中当前选项是否被选中
        If LstDJ.Selected(intCur) = True Then
             'ListBox控件中当前选项被选中，在变量strPSID中存储选中的
             '入库单单据编号
            strPSID = Left(LstDJ.List(intCur), 9)
            '设置并执行sql语句，创建用于临时存储物品详细信息汇总的mattmp表
            strSQL = "create table mattmp(p_id text(8)," & _
            "totalqty single,unit_price currency)"
            cmPSChk.CommandText = strSQL
            cmPSChk.Execute
            '设置并执行sql语句，将入库单详细信息表（ORDER_DETAIL_A）中
            '的入库单编号等于变量strPSID的值的记录加入到物品详细信息表
            '（MAT_DETAIL）中
            strSQL = "insert into mat_detail select p_id,qty,unit_price " & _
            "from order_detail_a where order_id='" & strPSID & "'"
            cmPSChk.CommandText = strSQL
            cmPSChk.Execute
             '设置并执行sql语句，将物品详细信息（MAT_DETAIL）表记录的汇总
             '信息存储到物品汇总信息表mattmp中
            strSQL = "insert into mattmp select p_id,sum(qty) as " & _
            "totalqty,unit_price from mat_detail group by p_id,unit_price"
            cmPSChk.CommandText = strSQL
            cmPSChk.Execute
            '设置并执行sql语句，删除物品详细信息汇总表中的所有记录
           strSQL = "delete from mat_detail"
            cmPSChk.CommandText = strSQL
            cmPSChk.Execute
            '设置并执行sql语句，将临时存储物品详细信息汇总的mattmp表的所
            '有记录插入到物品详细信息汇总表中
            strSQL = "insert into mat_detail select p_id,totalqty " & _
            "as qty,unit_price from  mattmp"
            cmPSChk.CommandText = strSQL
            cmPSChk.Execute
            '设置并执行sql语句，删除临时存储物品详细信息汇总的mattmp表
            strSQL = "drop table mattmp"
            cmPSChk.CommandText = strSQL
            cmPSChk.Execute
             
             '设置并执行sql语句，对入库单详细信息表中的单据编号等于变量
             'strPSID值的记录进行信息汇总，以得到物品的汇总信息，如总数
             '量和总金额。
            strSQL = "select p_id,sum(qty) as tq,sum(price) as tp from " & _
            "order_detail_a where order_id='" & strPSID & "' group by " & _
            "p_id"
            rsMHQP.Open strSQL, DEjxc.Conjxc, adOpenStatic, adLockReadOnly
            With rsMHQP
                .MoveFirst
                '依次将某种物品的汇总信息插入到物品信息汇总表中
                While Not .EOF
                    '设置并执行sql语句，以得到包含物品信息汇总表（mat_head）中
                    '物品编号等于数据集对象rsMHQP的p_id字段值的记录的数据集
                    '对象rsMAT_HEAD
                    strSQL = "select * from mat_head where p_id='" & !p_id & "'"
                    rsMAT_HEAD.Open strSQL, DEjxc.Conjxc, adOpenStatic, _
                    adLockReadOnly
                    '判断数据集对象rsMAT_HEAD是否为空
                    If rsMAT_HEAD.EOF Then
                       '数据集对象rsMAT_HEAD为空，设置用于在物品信息汇总表中
                       '插入当前物品的汇总信息的sql语句
                       strSQL = "insert into mat_head (p_id,qty,price) values('" & _
                       !p_id & "'," & !tq & "," & !tp & ")"
                    Else
                       '数据集对象rsMAT_HEAD不为空，设置用于在物品信息汇总表中
                       '更改当前物品的汇总信息的sql语句
                       strSQL = "update mat_head set qty=qty+" & !tq & _
                       ",price=price+" & !tp & " where p_id='" & !p_id & "'"
                    End If
                    '执行变量strSQL代表的sql语句
                    cmPSChk.CommandText = strSQL
                    cmPSChk.Execute
                    '将记录位置移到下一条
                    .MoveNext
                Wend
            End With
            rsMHQP.Close
            '设置并执行sql语句，将入库单单据的简单信息表中单据编号等于
            '变量strPSID值的记录插入到已审核的在入库单单据的简单信息表中
            strSQL = "insert into ps_head_b select * from ps_head_a " & _
            "where ps_id='" & strPSID & "'"
            cmPSChk.CommandText = strSQL
            cmPSChk.Execute
            '设置并执行sql语句，在入库单单据的简单信息表中删除单据编号等于
            '变量strPSID值的记录
            strSQL = "delete from ps_head_a " & "where ps_id='" & strPSID & "'"
            cmPSChk.CommandText = strSQL
            cmPSChk.Execute
            '将ORDER_DETAIL_A中的记录移动到ORDER_DETAIL_B中
            '设置并执行sql语句，将入库单单据的详细信息表中单据编号等于
            '变量strPSID值的记录插入到已审核的在入库单单据的详细信息表中
            strSQL = "insert into order_detail_b select * from " & _
            "order_detail_a where order_id='" & strPSID & "'"
            cmPSChk.CommandText = strSQL
            cmPSChk.Execute
            '设置并执行sql语句，在入库单单据的详细信息表中删除单据编号等于
            '变量strPSID值的记录
            strSQL = "delete from order_detail_a " & "where order_id='" & strPSID & "'"
            cmPSChk.CommandText = strSQL
            cmPSChk.Execute
        End If
    Next
End Sub

Private Sub Form_Unload(Cancel As Integer)
    intNumWindows = Closewindow(intNumWindows)
    rsPSChk.Close
    Set rsPSChk = Nothing
    Set cmPSChk = Nothing
    Set rsMHQP = Nothing
End Sub