frmotherchk.frm

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

VERSION 5.00
Begin VB.Form FrmOtherChk 
   Caption         =   "采购入库单审核"
   ClientHeight    =   4590
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   7020
   Icon            =   "FrmOtherChk.frx":0000
   LinkTopic       =   "Form1"
   ScaleHeight     =   4590
   ScaleWidth      =   7020
   StartUpPosition =   1  '所有者中心
   Begin VB.CommandButton CmdCheck 
      Caption         =   "全部放弃(&U)"
      Height          =   375
      Index           =   1
      Left            =   5100
      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            =   5100
      TabIndex        =   4
      Top             =   3540
      Width           =   1635
   End
   Begin VB.CommandButton CmdCheck 
      Caption         =   "审核过帐(&C)"
      Height          =   375
      Index           =   2
      Left            =   5100
      TabIndex        =   3
      Top             =   2760
      Width           =   1635
   End
   Begin VB.ListBox LstDJ 
      Height          =   3420
      Left            =   60
      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 = "FrmOtherChk"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private rsOTChk As ADODB.Recordset
Private cmOTChk As ADODB.Command
Private rsMHQP 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
            Call OTCheck
            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)
    Set rsOTChk = DEjxc.rsComOtHA
    rsOTChk.Open
    Set rsMHQP = New ADODB.Recordset
    Set cmOTChk = New ADODB.Command
    cmOTChk.ActiveConnection = DEjxc.Conjxc
    cmOTChk.CommandType = adCmdText
    With rsOTChk
        If .RecordCount <> 0 Then
            .MoveFirst
            While Not .EOF
                strItem = !other_id & Space(20) & !other_date
                LstDJ.AddItem strItem
                .MoveNext
            Wend
        End If
    End With
End Sub

Private Sub OTCheck()
    Dim strSQL As String
    Dim intCur As Integer
    Dim strOTID As String
    For intCur = 0 To LstDJ.ListCount - 1
        If LstDJ.Selected(intCur) = True Then
            strOTID = Left(LstDJ.List(intCur), 9)
'将ORDER_DETAIL_A中的记录加入到MAT_DETAIL中
'            strSQL = "create table mattmp(p_id text(8)," & _
'            "totalqty single,unit_price currency)"
'            cmOTChk.CommandText = strSQL
'            cmOTChk.Execute
'            strSQL = "insert into mat_detail select p_id,qty,unit_price " & _
'            "from order_detail_a where order_id='" & strOTID & "'"
'            cmOTChk.CommandText = strSQL
'            cmOTChk.Execute
'            strSQL = "insert into mattmp select p_id,sum(qty) as " & _
'            "totalqty,unit_price from mat_detail group by p_id,unit_price"
'            cmOTChk.CommandText = strSQL
'            cmOTChk.Execute
'            strSQL = "delete from mat_detail"
'            cmOTChk.CommandText = strSQL
'            cmOTChk.Execute
'            strSQL = "insert into mat_detail select p_id,totalqty " & _
'            "as qty,unit_price from  mattmp"
'            cmOTChk.CommandText = strSQL
'            cmOTChk.Execute
'            strSQL = "drop table mattmp"
'            cmOTChk.CommandText = strSQL
'            cmOTChk.Execute
'将ORDER_DETAIL_A中的记录加入到MAT_HEAD中
            strSQL = "select p_id,sum(qty) as tq,sum(price) as tp from " & _
            "order_detail_a where order_id='" & strOTID & "' group by " & _
            "p_id"
            rsMHQP.Open strSQL, DEjxc.Conjxc, adOpenStatic, adLockReadOnly
            With rsMHQP
                .MoveFirst
                While Not .EOF
                    strSQL = "update mat_head set qty=qty+" & !tq & _
                    ",price=price+" & !tp & " where p_id='" & !p_id & "'"
                    cmOTChk.CommandText = strSQL
                    cmOTChk.Execute
                    .MoveNext
                Wend
            End With
            rsMHQP.Close
'将other_head_a中的记录移动到other_head_b中
            strSQL = "insert into other_head_b select * from other_head_a " & _
            "where other_id='" & strOTID & "'"
            cmOTChk.CommandText = strSQL
            cmOTChk.Execute
            strSQL = "delete from other_head_a " & "where other_id='" & strOTID & "'"
            cmOTChk.CommandText = strSQL
            cmOTChk.Execute
'将ORDER_DETAIL_A中的记录移动到ORDER_DETAIL_B中
            strSQL = "insert into order_detail_b select * from " & _
            "order_detail_a where order_id='" & strOTID & "'"
            cmOTChk.CommandText = strSQL
            cmOTChk.Execute
            strSQL = "delete from order_detail_a " & "where order_id='" & strOTID & "'"
            cmOTChk.CommandText = strSQL
            cmOTChk.Execute
        End If
    Next
End Sub

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