frm商品盘点损盈报告.frm

服装销售系统,VB开发.没有解压密码

'将表的表头和明细清空
Private Sub ClearTable()
    '清空表头
    txtPurcode.Text = ""
'    txtMngno.Text = ""
    txtPurdate.Text = ""    ' CStr(Now)
'    txtFanno.Text = ""
    txtIptno.Text = ""
    txtIamt.Text = ""
    
    '清空明细
    grdDET.Update
    grdDET.RemoveAll
End Sub

'刷新表显示

Private Sub RefreshTable(vRs As ADODB.Recordset)
    On Error GoTo RefErr
    If vRs.EOF Or vRs.BOF Then Exit Sub
    grdDET.Update
    grdDET.RemoveAll
    
    '表头文本框刷新
    txtPurcode.Text = vRs("表单号")
    cmbSaleStyle.Text = vRs("销售方式")
    cmbGroup.Text = vRs("分店编码")
'    txtMngno.Text = vRs("经理")
'    txtFanno.Text = vRs("审核员")
    txtPurdate.Text = CStr(Format(vRs("制表日期"), "YYYY-MM-DD"))
    txtIptno.Text = vRs("录入员")
    
    '如果确认状态为真则不允许修改
    If vRs("确认状态").Value Then
        cmdToolCommit.Enabled = False
        cmdToolDelete.Enabled = False
        cmdToolSave.Enabled = False
    Else
        cmdToolCommit.Enabled = True
        cmdToolDelete.Enabled = True
        cmdToolSave.Enabled = True
    End If
    
    While Not vRs.EOF
        Temp = vRs("商品编码") & vbTab & _
                vRs("品名") & vbTab & _
                vRs("单位") & vbTab & _
                vRs("盘亏数量") & vbTab & _
                vRs("进价") & vbTab & _
                vRs("盘亏金额")
        grdDET.AddItem Temp
        '记录后移
        vRs.MoveNext
    Wend
    Call CalTotalDelete
    Exit Sub
RefErr:
    ErrNum = Err.number
    MsgBox "读数据库发生错误!" & vbCrLf & Error$(ErrNum), vbExclamation, "提示窗口"

End Sub

'保存表
Private Function SaveTable() As Boolean
    On Error GoTo SaveErr
    Dim N
    Dim ChainCode As String
    
    If optCenter.Value Then
        Temp = "配送中心"
        ChainCode = "无"
    Else
        Temp = "分店"
        ChainCode = cmbGroup.Text
    End If
    
    grdDET.MoveFirst
    For N = 0 To grdDET.Rows - 1
        sSQL = "INSERT INTO  " & TableName & " (销售方式,盘点部门,表单号,分店编码,制表日期,经理,审核员,录入员" & _
            ",商品编码,品名,单位,盘亏数量,进价,盘亏金额)" & _
            " VALUES('"
        sSQL = sSQL & _
            Trim(cmbSaleStyle.Text) & "','" & _
            Temp & "','" & _
            Trim(txtPurcode.Text) & "','" & _
            ChainCode & "','" & _
            Trim(txtPurdate.Text) & "','" & _
            "00000" & "','" & _
            "00000" & "','" & _
            Trim(txtIptno.Text) & "','"
            
        sSQL = sSQL & _
            Trim(grdDET.Columns(0).Text) & "','" & _
            Trim(grdDET.Columns(1).Text) & "','" & _
            Trim(grdDET.Columns(2).Text) & "'," & _
            Val(grdDET.Columns(3).Value) & "," & _
            Val(grdDET.Columns(4).Value) & "," & _
            Val(grdDET.Columns(5).Value) & ")"
        If RunSQL(sSQL) <> 0 Then
            SaveTable = False
            Exit Function
        End If
        grdDET.MoveNext
    Next N
    SaveTable = True
    Exit Function
SaveErr:
    ErrNum = Err.number
    MsgBox "保存数据库发生错误!", vbExclamation, "提示窗口"
End Function

Private Sub cmbGroup_GotFocus()
    cmbGroup.DroppedDown = True
End Sub

Private Sub cmbGroup_InitColumnProps()
    On Error GoTo LinkErr
    Set Rs = Nothing
    Rs.Open "SELECT * FROM 分店主档", Conn, adOpenStatic, adLockReadOnly
    While Not Rs.EOF
        cmbGroup.AddItem Rs("分店编码") + vbTab + Rs("分店名称")
        Rs.MoveNext
    Wend
    Exit Sub
LinkErr:
    MsgBox "初始化数据错误！" & Err.Description, vbExclamation, "错误窗口"
End Sub

Private Sub cmbSaleStyle_InitColumnProps()
    cmbSaleStyle.AddItem "经销"
    cmbSaleStyle.AddItem "代销"
End Sub


'增加新表
Private Sub cmdToolAdd_Click()
    On Error Resume Next
    TableState = "新建"
    grdDET.AllowUpdate = True
    grdDET.SelectByCell = False
    Set Rs = Nothing
    QueryFlag = False
    Call ShowStatus(2)
    '清除整个表显示
    Call ClearTable
    txtIptno.Text = UserCode
    txtPurcode.Text = GeneratePurcode(TableName)

    cmdToolSave.Enabled = True
    cmdToolCommit.Enabled = False
    cmdToolPrevious.Enabled = False
    cmdToolNext.Enabled = False
    cmdToolDelete.Enabled = False
'    txtPurcode.SetFocus
End Sub

Private Sub SaleGoods()
            
    Dim RsTemp As New ADODB.Recordset
    Dim DataOK As Boolean
    Dim R As New ADODB.Recordset
    Dim IIprc
    Dim GoodsNum
    Dim strOperMsg As String
    Dim N
    On Error GoTo CommitErr
    Conn.BeginTrans
    sSQL = "UPDATE 盘点盈亏报告单 SET 确认状态=1 WHERE 表单号='" & txtPurcode.Text & "'"
    
    If RunSQL(sSQL) <> 0 Then
        MsgBox "确认失败!,请检查数据是否正确!" & vbCrLf & Error$(ErrNum), vbExclamation, "提示窗口"
        Conn.RollbackTrans
        Exit Sub
    End If
    
    grdDET.MoveFirst
    For N = 0 To grdDET.Rows - 1
        Temp = grdDET.Columns(3).Value
        sSQL = "SELECT * FROM  商品主档 WHERE 商品编码='" & Trim(grdDET.Columns(0).Text) & "'"
        Set RsTemp = Nothing
        RsTemp.Open sSQL, Conn, adOpenStatic, adLockReadOnly
        
        '修改经销库存
        If optCenter.Value Then
            sSQL = "SELECT * FROM 配送中心库存 WHERE 商品编码='" & Trim(grdDET.Columns(0).Text) & _
                    "' AND 经营方式='" & Trim(cmbSaleStyle.Text) & "'"
            Set R = Nothing
            R.Open sSQL, Conn, adOpenStatic, adLockPessimistic
            If R.EOF Then GoTo CommitErr
            R.Fields("数量").Value = R("数量") + Temp
            R.Fields("进价金额").Value = R.Fields("进价金额").Value + RsTemp("进价") * Temp
            R.Fields("售价金额").Value = R("售价金额") + RsTemp("零售价") * Temp
            R.Update
            
            If R("数量") > 0 Then
                IIprc = Format(R("进价金额") / R("数量"), DecNum)
                sSQL = "UPDATE 商品主档 SET 进价=" & Val(IIprc) & " WHERE 商品编码='" & Trim(grdDET.Columns(0).Text) & "'"
                Cmd.ActiveConnection = Conn
                Cmd.CommandText = sSQL
                Cmd.Execute
            End If
            
        Else
            sSQL = "SELECT * FROM 连锁店库存 WHERE 商品编码='" & Trim(grdDET.Columns(0).Text) & _
                    "' AND 经营方式='" & Trim(cmbSaleStyle.Text) & "'"
            Set R = Nothing
            R.Open sSQL, Conn, adOpenStatic, adLockPessimistic
            If R.EOF Then GoTo CommitErr
            R.Fields("数量").Value = R("数量") + Temp
            R.Fields("进价金额").Value = R.Fields("进价金额").Value + RsTemp("进价") * Temp
            R.Fields("售价金额").Value = R("售价金额") + RsTemp("零售价") * Temp
            R.Update
        End If
        
        RsTemp.MoveNext
        
        grdDET.MoveNext
    Next N

    cmdToolCommit.Enabled = False
    cmdToolSave.Enabled = False
    cmdToolDelete.Enabled = False
    Conn.CommitTrans
    Exit Sub
CommitErr:
    Conn.RollbackTrans
    MsgBox "确认失败!,请检查数据是否存在错误!" & vbCrLf & Err.Description, vbExclamation, "警告窗口"
End Sub

'
'确认数据,导致数据不能再次修改.
'
Private Sub cmdToolCommit_Click()
    If txtPurcode.Text = "" Then
        MsgBox "表单号不能为空!", vbExclamation, "提示窗口"
        Exit Sub
    End If
    Temp = "确认之后将不能再作改动,继续吗?"
    Temp = MsgBox(Temp, vbQuestion + vbYesNo, "提示窗口")
    If Temp = vbYes Then
        '对于短货按销售处理
        If Not CommSaveTable() Then
            MsgBox "保存数据时发生错误!", vbExclamation, "错误窗口"
            Exit Sub
        End If
        Call SaleGoods
    End If
End Sub

'删除当前表
Private Sub cmdToolDelete_Click()
    On Error Resume Next
    
    Call ShowStatus(88)
    If txtPurcode.Text = "" Then
        MsgBox "当前表单为空!", vbExclamation, "提示窗口"
        Exit Sub
    End If
    
    Temp = "确认之要删除该表吗?" & vbCrLf & "表单号为：" & txtPurcode.Text
    Temp = MsgBox(Temp, vbQuestion + vbYesNo, "提示窗口")
    If Temp = vbYes Then
        
        sSQL = "DELETE  FROM " & TableName & " WHERE 表单号='" & txtPurcode.Text & "'"
        RunSQL sSQL
        
        Call ClearTable
        cmdToolPrevious.Enabled = False
        cmdToolNext.Enabled = False
        Call ShowStatus(5)
    End If
End Sub

'退出
Private Sub cmdToolExit_Click()
    Unload Me
End Sub

'设置是否进行合法性验证
Private Sub SetValidate(Flag As Boolean)
    txtPurcode.CausesValidation = Flag
    txtPurdate.CausesValidation = Flag
'    txtMngno.Validation = Flag
'    txtFanno.Validation = Flag
    txtIptno.Validation = Flag
    grdDET.CausesValidation = Flag
End Sub

'生成查询条件
Private Function GenerateQuerySQL() As String
    Dim strTemp As String
    sSQL = "SELECT  表单号 FROM 盘点盈亏报告单 "
    If txtPurcode.Text <> "" Then
        strTemp = strTemp & "  表单号" & _
            AnalyseCondition(txtPurcode.Text, True) & " AND"
    End If
    If optChain.Value Then
        If cmbGroup.Text <> "" Then
            strTemp = strTemp & "  分店编码 " & _
                AnalyseCondition(cmbGroup.Text, True) & " AND"
        End If
    End If
    If txtPurdate.Text <> "" Then
        strTemp = strTemp & "  制表日期 BETWEEN '" & _
                Format(txtPurdate.Text, "YYYY-MM-DD 00:00") & "' AND '" & _
                Format(txtPurdate.Text, "YYYY-MM-DD") & " 23:59' AND "
    End If
'    If txtMngno.Text <> "" Then
'        strTemp = strTemp & "  经理 " & _
'            AnalyseCondition(txtMngno.Text, True) & " AND"
'    End If
'    If txtFanno.Text <> "" Then
'        strTemp = strTemp & " 审核员 " & _
'            AnalyseCondition(txtFanno.Text, True) & " AND"
'    End If
    If txtIptno.Text <> "" Then
        strTemp = strTemp & "  录入员 " & _
            AnalyseCondition(txtIptno.Text, True) & " AND"
    End If
    If grdDET.Columns(0).CellText(0) <> "" Then
        strTemp = strTemp & "  商品编码 " & _
            AnalyseCondition(grdDET.Columns(0).CellText(0), True) & " AND"
    End If
    
'    If grdDET.Columns(1).CellText(0) <> "" Then
'        strTemp = strTemp & "  品名 " & _
'            AnalyseCondition(grdDET.Columns(1).CellText(0), True) & " AND"
'    End If
'
'    If grdDET.Columns(2).CellText(0) <> "" Then
'        strTemp = strTemp & "  单位 " & _
'            AnalyseCondition(grdDET.Columns(2).CellText(0), False) & " AND"
'    End If
    If grdDET.Columns(3).CellText(0) <> "" Then
        strTemp = strTemp & "  盘亏数量 " & _
            AnalyseCondition(grdDET.Columns(3).CellText(0), False) & " AND"
    End If
'    If grdDET.Columns(4).CellText(0) <> "" Then
'        strTemp = strTemp & "  进价" & _
'            AnalyseCondition(grdDET.Columns(4).CellText(0), False) & " AND"
'    End If
    
    If strTemp <> "" Then
        sSQL = sSQL & " WHERE " & Mid(strTemp, 1, Len(strTemp) - 4)
    End If