frmsellck.frm

一个简单但功能强大的进货系统,同样适合用于毕业论文的设计

VERSION 5.00
Begin VB.Form frmSellCk 
   Caption         =   "出库审核"
   ClientHeight    =   4290
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   6960
   Icon            =   "frmSellCk.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   ScaleHeight     =   4290
   ScaleWidth      =   6960
   StartUpPosition =   1  '所有者中心
   Begin VB.ListBox LstDJ 
      Height          =   3420
      Left            =   120
      Style           =   1  'Checkbox
      TabIndex        =   4
      Top             =   720
      Width           =   4755
   End
   Begin VB.CommandButton CmdCheck 
      Caption         =   "审核过帐(&C)"
      Height          =   375
      Index           =   2
      Left            =   5160
      TabIndex        =   3
      Top             =   2700
      Width           =   1635
   End
   Begin VB.CommandButton CmdCheck 
      Caption         =   "退出(&X)"
      Height          =   375
      Index           =   3
      Left            =   5160
      TabIndex        =   2
      Top             =   3480
      Width           =   1635
   End
   Begin VB.CommandButton CmdCheck 
      Caption         =   "全部选中(&A)"
      Height          =   375
      Index           =   0
      Left            =   5160
      TabIndex        =   1
      Top             =   1140
      Width           =   1635
   End
   Begin VB.CommandButton CmdCheck 
      Caption         =   "全部放弃(&U)"
      Height          =   375
      Index           =   1
      Left            =   5160
      TabIndex        =   0
      Top             =   1920
      Width           =   1635
   End
   Begin VB.Label LblCap 
      Caption         =   "请先选中将要审核过帐的单据，然后点击“审核过帐”按钮"
      Height          =   195
      Index           =   0
      Left            =   120
      TabIndex        =   6
      Top             =   120
      Width           =   5235
   End
   Begin VB.Label LblCap 
      Caption         =   "单据编号                       日期"
      Height          =   195
      Index           =   1
      Left            =   360
      TabIndex        =   5
      Top             =   480
      Width           =   4395
   End
End
Attribute VB_Name = "frmSellCk"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim rsSeCk As ADODB.Recordset
Dim cmdSeCk As ADODB.Command
Dim rsQ As ADODB.Recordset

Private Sub CmdCheck_Click(Index As Integer)
    
    Dim intNum As Integer
    Select Case Index
        Case 0
            For intNum = 0 To Me.LstDJ.ListCount - 1
                If Me.LstDJ.Selected(intNum) = False Then
                    Me.LstDJ.Selected(intNum) = True
                End If
            Next
                    
        Case 1
            For intNum = 0 To Me.LstDJ.ListCount - 1
                If Me.LstDJ.Selected(intNum) = True Then
                    Me.LstDJ.Selected(intNum) = False
                End If
            Next
            
        Case 2
            Call SeCK
            For intNum = Me.LstDJ.ListCount - 1 To 0 Step -1
                If Me.LstDJ.Selected(intNum) = True Then
                    Me.LstDJ.RemoveItem intNum
                End If
            Next
            MsgBox "审核过帐完毕!", , "审核过帐"
        Case 3
            Unload Me
    End Select
    
    
End Sub

Private Sub SeCK()
    
    Dim strsql As String
    Dim intNum As Integer
    Dim strSeID As String
    For intNum = 0 To Me.LstDJ.ListCount - 1
        If Me.LstDJ.Selected(intNum) = True Then
            strSeID = Left(Me.LstDJ.List(intNum), 9)
            
            strsql = "select 商品编号,sum(数量) as tq,sum(总额) as tp from " & _
            "出库表_tmp where 出库编号='" & strSeID & "' group by " & _
            "商品编号"
            Set rsQ = ExecuteSQL(strsql)
            With rsQ
                .MoveFirst
                While Not .EOF
                    strsql = "update 盘点表 set 数量=数量-" & !tq & _
                    ",总额=总额-" & !tp & " where 商品编号='" & !商品编号 & "'"
                    cmdSeCk.CommandText = strsql
                    cmdSeCk.Execute
                    .MoveNext
                Wend
            End With
            rsQ.Close
        '将[销售出库表_tmp]中的记录移动到[销售出库表]中
            strsql = "insert into 销售出库表 select * from 销售出库表_tmp where 单据编号='" & strSeID & "'"
            cmdSeCk.CommandText = strsql
            cmdSeCk.Execute
            strsql = "delete from 销售出库表_tmp where 单据编号='" & strSeID & "'"
            cmdSeCk.CommandText = strsql
            cmdSeCk.Execute
        '将[出库表_tmp]中的记录移动到[出库表]中
            strsql = "insert into 出库表 select * from 出库表_tmp where 出库编号='" & strSeID & "'"
            cmdSeCk.CommandText = strsql
            cmdSeCk.Execute
            strsql = "delete from 出库表_tmp where 出库编号='" & strSeID & "'"
            cmdSeCk.CommandText = strsql
            cmdSeCk.Execute
        End If
    Next
            
End Sub

Private Sub Form_Load()
    Dim strsql As String
    Dim strItem As String
    strsql = "select * from 销售出库表_tmp order by 单据编号"
    'Set rsPsCk = DEaccp.rsCom订购入库信息
    Set rsSeCk = New Recordset
    rsSeCk.CursorLocation = adUseClient
    Set rsSeCk = ExecuteSQL(strsql)
    
    Set cmdSeCk = New Command
    Set rsQ = New Recordset
    cmdSeCk.ActiveConnection = Module.ConnectString
    cmdSeCk.CommandType = adCmdText
    
    With rsSeCk
        If .RecordCount <> 0 Then
            .MoveFirst
            While Not .EOF
                strItem = !单据编号 & Space(20) & !销售日期
                Me.LstDJ.AddItem strItem
                .MoveNext
            Wend
        End If
    End With
    
        

End Sub

Private Sub Form_Unload(Cancel As Integer)
    rsSeCk.Close
    Set rsSeCk = Nothing
    Set cmdSeCk = Nothing
    Set rsQ = Nothing
    
    
End Sub