frmpsck.frm

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

VERSION 5.00
Begin VB.Form frmPsCk 
   Caption         =   "订购入库审核"
   ClientHeight    =   4320
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   6990
   Icon            =   "frmPsCk.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   ScaleHeight     =   4320
   ScaleWidth      =   6990
   StartUpPosition =   1  '所有者中心
   Begin VB.ListBox LstDJ 
      Height          =   3420
      Left            =   120
      Style           =   1  'Checkbox
      TabIndex        =   6
      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        =   5
      Top             =   120
      Width           =   5235
   End
   Begin VB.Label LblCap 
      Caption         =   "单据编号                       日期"
      Height          =   195
      Index           =   1
      Left            =   360
      TabIndex        =   4
      Top             =   480
      Width           =   4395
   End
End
Attribute VB_Name = "frmPsCk"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim rsPsCk As ADODB.Recordset
Dim cmdPsCk 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 PSCK
            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 PSCK()
    
    Dim strsql As String
    Dim intNum As Integer
    Dim strPSID As String
    For intNum = 0 To Me.LstDJ.ListCount - 1
        If Me.LstDJ.Selected(intNum) = True Then
            strPSID = Left(Me.LstDJ.List(intNum), 9)
            
            strsql = "select 商品编号,sum(数量) as tq,sum(总额) as tp from " & _
            "库存表_tmp where 入库编号='" & strPSID & "' group by " & _
            "商品编号"
            Set rsQ = ExecuteSQL(strsql)
            With rsQ
                .MoveFirst
                While Not .EOF
                    strsql = "update 盘点表 set 数量=数量+" & !tq & _
                    ",总额=总额+" & !tp & " where 商品编号='" & !商品编号 & "'"
                    cmdPsCk.CommandText = strsql
                    cmdPsCk.Execute
                    .MoveNext
                Wend
            End With
            rsQ.Close
        '将[订购入库表_tmp]中的记录移动到[订购入库表]中
            strsql = "insert into 订购入库表 select * from 订购入库表_tmp " & _
            "where 入库编号='" & strPSID & "'"
            cmdPsCk.CommandText = strsql
            cmdPsCk.Execute
            strsql = "delete from 订购入库表_tmp where 入库编号='" & strPSID & "'"
            cmdPsCk.CommandText = strsql
            cmdPsCk.Execute
        '将[库存表_tmp]中的记录移动到[库存表]中
            strsql = "insert into 库存表 select * from 库存表_tmp where 入库编号='" & strPSID & "'"
            cmdPsCk.CommandText = strsql
            cmdPsCk.Execute
            strsql = "delete from 库存表_tmp where 入库编号='" & strPSID & "'"
            cmdPsCk.CommandText = strsql
            cmdPsCk.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 rsPsCk = New Recordset
    rsPsCk.CursorLocation = adUseClient
    Set rsPsCk = ExecuteSQL(strsql)
    
    Set cmdPsCk = New Command
    Set rsQ = New Recordset
    cmdPsCk.ActiveConnection = Module.ConnectString
    cmdPsCk.CommandType = adCmdText
    
    With rsPsCk
        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)
    rsPsCk.Close
    Set rsPsCk = Nothing
    Set cmdPsCk = Nothing
    Set rsQ = Nothing
    
    
End Sub