www.pudn.com > Pepsi_five.rar > FrmSaleChk.frm

VERSION 5.00 
Begin VB.Form FrmSaleChk  
   Caption         =   "出库单审核" 
   ClientHeight    =   4590 
   ClientLeft      =   60 
   ClientTop       =   345 
   ClientWidth     =   7020 
   Icon            =   "FrmSaleChk.frx":0000 
   LinkTopic       =   "Form1" 
   MDIChild        =   -1  'True 
   ScaleHeight     =   4590 
   ScaleWidth      =   7020 
   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 = "FrmSaleChk" 
Attribute VB_GlobalNameSpace = False 
Attribute VB_Creatable = False 
Attribute VB_PredeclaredId = True 
Attribute VB_Exposed = False 
Option Explicit 
Private rsSAChk As ADODB.Recordset 
Private cmSAChk 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 SACheck 
            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 rsSAChk = DEjxc.rsComSaleHA 
    rsSAChk.Open 
    Set rsMHQP = New ADODB.Recordset 
    Set cmSAChk = New ADODB.Command 
    cmSAChk.ActiveConnection = DEjxc.Conjxc 
    cmSAChk.CommandType = adCmdText 
    With rsSAChk 
        If .RecordCount <> 0 Then 
            .MoveFirst 
            While Not .EOF 
                strItem = !sale_id & Space(20) & !sale_date 
                LstDJ.AddItem strItem 
                .MoveNext 
            Wend 
        End If 
    End With 
End Sub 
 
Private Sub SACheck() 
    Dim strSQL As String 
    Dim intCur As Integer 
    Dim strSAID As String 
    For intCur = 0 To LstDJ.ListCount - 1 
        If LstDJ.Selected(intCur) = True Then 
            strSAID = Left(LstDJ.List(intCur), 9) 
'将sale_detail_a中的记录加入到MAT_DETAIL中 
'            strSQL = "create table mattmp(p_id text(8)," & _ 
'            "totalqty single,unit_price currency)" 
'            cmSAChk.CommandText = strSQL 
'            cmSAChk.Execute 
'            strSQL = "insert into mattmp select p_id,-qty as totalqty,unit_price " & _ 
'            "from sale_detail_a where sale_id='" & strSAID & "'" 
'            cmSAChk.CommandText = strSQL 
'            cmSAChk.Execute 
'            strSQL = "insert into mattmp select p_id,qty as totalqty,unit_price " & _ 
'            "from mat_detail" 
'            cmSAChk.CommandText = strSQL 
'            cmSAChk.Execute 
'            strSQL = "delete from mat_detail" 
'            cmSAChk.CommandText = strSQL 
'            cmSAChk.Execute 
'            strSQL = "insert into mat_detail select p_id,sum(totalqty) as " & _ 
'            "qty,unit_price from mattmp group by p_id,unit_price" 
'            cmSAChk.CommandText = strSQL 
'            cmSAChk.Execute 
'            strSQL = "delete from mat_detail where qty=0" 
'            cmSAChk.CommandText = strSQL 
'            cmSAChk.Execute 
'            strSQL = "drop table mattmp" 
'            cmSAChk.CommandText = strSQL 
'            cmSAChk.Execute 
'将sale_detail_a中的记录加入到MAT_HEAD中 
            strSQL = "select p_id,sum(qty) as tq,sum(price) as tp from " & _ 
            "sale_detail_a where sale_id='" & strSAID & "' 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 & "'" 
                    cmSAChk.CommandText = strSQL 
                    cmSAChk.Execute 
                    .MoveNext 
                Wend 
            End With 
            rsMHQP.Close 
'将sale_head_a中的记录移动到sale_head_b中 
            strSQL = "insert into sale_head_b select * from sale_head_a " & _ 
            "where sale_id='" & strSAID & "'" 
            cmSAChk.CommandText = strSQL 
            cmSAChk.Execute 
            strSQL = "delete from sale_head_a " & "where sale_id='" & strSAID & "'" 
            cmSAChk.CommandText = strSQL 
            cmSAChk.Execute 
'将sale_detail_a中的记录移动到sale_detail_b中 
            strSQL = "insert into sale_detail_b select * from " & _ 
            "sale_detail_a where sale_id='" & strSAID & "'" 
            cmSAChk.CommandText = strSQL 
            cmSAChk.Execute 
            strSQL = "delete from sale_detail_a " & "where sale_id='" & strSAID & "'" 
            cmSAChk.CommandText = strSQL 
            cmSAChk.Execute 
        End If 
    Next 
End Sub 
 
Private Sub Form_Unload(Cancel As Integer) 
    intNumWindows = Closewindow(intNumWindows) 
    rsSAChk.Close 
    Set rsSAChk = Nothing 
    Set cmSAChk = Nothing 
    Set rsMHQP = Nothing 
End Sub