frm调进价单.frm

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

                "," & GoodsNum & _
                "," & GoodsNum & _
                ",'" & Format(txtPurdate.Text, "YYYY-MM-DD") & _
                "','" & cmbProvider.Text & _
                "','" & txtIptno.Text & _
                "',1" & _
                "," & v已售数量 & _
                "," & v售完标志 & ")"
            If RunSQL(sSQL) <> 0 Then
                MsgBox "生成新表单时发生错误!", vbExclamation, "提示窗口"
                Conn.RollbackTrans
                Exit Sub
            End If
            
            strOperMsg = strOperMsg & vbCrLf & "生成调入部门进货单：单号--" & Mid(RsTemp("表单号"), 1, 7) & "T" & Trim(txtPurcode.Text)
    
            RsTemp.MoveNext
        Wend
        If Temp <> 0 And RsTemp.EOF Then
            MsgBox "调价失败，商品数量不足!", vbInformation, "提示窗口"
            Conn.RollbackTrans
            Exit Sub
        End If
        
        
        '更改库存中的进价金额
        sSQL = "UPDATE 配送中心库存 SET 进价金额=进价金额+" & grdDET.Columns(6).Value & _
            " WHERE 商品编码='" & Trim(grdDET.Columns(0).Text) & "'" & _
            " AND 经营方式='代销'"
        Cmd.ActiveConnection = Conn
        Cmd.CommandText = sSQL
        Cmd.Execute
        
        '***********************************************
        '修改商品主档中的进价
        '***********************************************
        
        sSQL = "UPDATE 商品主档 SET 进价=" & grdDET.Columns(5).Value & _
            " WHERE 商品编码='" & grdDET.Columns(0).Text & "'"
        If RunSQL(sSQL) <> 0 Then
            MsgBox "修改商品主档时失败!,请检查数据是否正确!", vbExclamation, "提示窗口"
            Conn.RollbackTrans
            Exit Sub
        End If
        
        grdDET.MoveNext
    Next I
    
    strOperMsg = strOperMsg & vbCrLf & "调进价成功!"
'    Load frm运行结果
'    frm运行结果!txt结果.Text = strOperMsg
'    frm运行结果.Show 1
    
    cmdToolCommit.Enabled = False
    cmdToolSave.Enabled = False
    Conn.CommitTrans
    Exit Sub
PrcErr:
    MsgBox "调进价失败!", vbExclamation, "错误窗口"
    Conn.RollbackTrans
End Sub

'
'检查数据是否合法
'
Private Function DataOK() As Boolean
    
    
    If Trim(txtPurcode.Text) = "" Then
        DataOK = False
        Exit Function
    End If
    If Trim(cmbProvider.Text) = "" Then
        DataOK = False
        Exit Function
    End If
    If Trim(txtPurdate.Text) = "" Then
        DataOK = False
        Exit Function
    End If
'    If Trim(txtRtfno.Text) = "" Then
'        DataOK = False
'        Exit Function
'    End If
'    If Trim(txtManager.Text) = "" Then
'        DataOK = False
'        Exit Function
'    End If
    If Trim(txtIptno.Text) = "" Then
        DataOK = False
        Exit Function
    End If
    
    If grdDET.Rows = 0 Then
        DataOK = False
        Exit Function
    End If
    DataOK = True
End Function


'在状态条上显示记录信息和状态信息

Private Sub ShowStatus(Flag As Integer)
    Select Case Flag
        Case 0      '查询记录移动
            If Rs.EOF Then
                Temp = "已经移到记录末尾了"
            ElseIf Rs.BOF Then
                Temp = "已经移到记录开始"
            Else
                Temp = "第" & Rs.AbsolutePosition & "条"
            End If
            stbData.Panels("状态信息").Text = "总共:" & Rs.RecordCount & _
                "条之第: " & Temp
        Case 1      '开始查询
            stbData.Panels("状态信息").Text = "请输入查询条件:"
        Case 2      '请输入新表单
            stbData.Panels("状态信息").Text = "请输入新表单:"
        Case 3      '保存表单
            stbData.Panels("状态信息").Text = "表单保存完毕"
        Case 4      '保存表单
            stbData.Panels("状态信息").Text = "该表单已经确认"
        Case 5
            stbData.Panels("状态信息").Text = "该表单已经删除 "
        Case Else
            stbData.Panels("状态信息").Text = ""
    End Select
End Sub


'将表的表头和明细清空
Private Sub ClearTable()
    '清空表头
    txtPurcode.Text = ""
    cmbProvider.Text = ""
    txtGrpName.Text = ""
    
    txtPurdate.Text = ""        'CStr(Now)
'    txtRtfno.Text = ""
'    txtManager.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("表单号")
    cmbProvider.Text = vRs("厂商编码")
    txtPurdate.Text = CStr(Format(vRs("制表日期"), "YYYY-MM-DD 00:00"))
'    txtRtfno.Text = vRs("审核员")
'    txtManager.Text = vRs("部门经理")
    txtIptno.Text = vRs("录入员")
    
    '如果确认状态为真则不允许修改
    If vRs("确认状态").Value Then
        cmdToolCommit.Enabled = False
        cmdToolDelete.Enabled = False
        cmdToolSave.Enabled = False
        grdDET.AllowUpdate = False
    Else
        cmdToolCommit.Enabled = True
        cmdToolDelete.Enabled = True
        cmdToolSave.Enabled = True
        grdDET.AllowUpdate = True
    End If
    
    While Not vRs.EOF
        grdDET.AddItem Trim(vRs("商品编码")) & vbTab & _
                    Trim(vRs("品名")) & vbTab & _
                    Trim(vRs("单位")) & vbTab & _
                    Str(vRs("数量")) & vbTab & _
                    Str(vRs("原进价")) & vbTab & _
                    Str(vRs("现进价")) & vbTab & _
                    Str(vRs("进价差额"))
        '记录后移
        vRs.MoveNext
    Wend
    Call CalTotal
    Exit Sub
RefErr:
    ErrNum = Err.Number
    MsgBox "读数据库发生错误!" & vbCrLf & Error$(ErrNum), vbExclamation, "提示窗口"

End Sub

'保存表
Private Function SaveTable() As Boolean
    On Error GoTo TransErr
    grdDET.Update
    '增加记录
    grdDET.MoveFirst
    For I = 0 To grdDET.Rows - 1
    sSQL = "INSERT INTO 进价调整单(表单号, 制表日期,厂商编码, " & _
        "审核员, 部门经理, 录入员, 商品编码, 品名, 单位, " & _
        "数量,原进价,现进价, 进价差额)VALUES('" & _
            Trim(txtPurcode.Text) & "','" & _
            Trim(txtPurdate.Text) & "','" & _
            Trim(cmbProvider.Text) & "','" & _
            "00000" & "','" & _
            "00000" & "','" & _
            Trim(txtIptno.Text) & "','" & _
            grdDET.Columns(0).Value & "','" & _
            grdDET.Columns(1).Value & "','" & _
            grdDET.Columns(2).Value & "'," & _
            Str(grdDET.Columns(3).Value) & "," & _
            Str(grdDET.Columns(4).Value) & "," & _
            Str(grdDET.Columns(5).Value) & "," & _
            Str(grdDET.Columns(6).Value) & ")"
           
        If RunSQL(sSQL) <> 0 Then
            MsgBox "明细更新失败!" & vbCrLf & Error$(ErrNum), vbExclamation, "警告窗口"
            SaveTable = False
            Exit Function
        End If
        grdDET.MoveNext
    Next I
    SaveTable = True
    Exit Function
TransErr:       '错误处理
    SaveTable = False
    ErrNum = Err.Number
End Function


Private Sub cmbProvider_CloseUp()
    txtGrpName.Text = cmbProvider.Columns(1).Text
End Sub

Private Sub cmbProvider_GotFocus()
    cmbProvider.DroppedDown = True
End Sub

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

'增加新表
Private Sub cmdToolAdd_Click()
    On Error Resume Next
    TableState = "新建"
    grdDET.AllowUpdate = True
    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 cmdToolCommit_Click()
    On Error GoTo ComErr
    If txtPurcode.Text = "" Then
        MsgBox "表单号不能为空!", vbExclamation, "提示窗口"
        Exit Sub
    End If
    Temp = "确认之后将不能再作改动,继续吗?"
    Temp = MsgBox(Temp, vbQuestion + vbYesNo, "提示窗口")
    If Temp = vbNo Then Exit Sub
    If Not CommSaveTable() Then
        MsgBox "保存数据时发生错误!", vbExclamation, "错误窗口"
        Exit Sub
    End If
    Call Oper代销市场调进价
    Exit Sub
ComErr:
    ErrNum = Err.Number
    MsgBox "确认失败!,请检查数据是否正确!" & vbCrLf & Error$(ErrNum), vbExclamation, "提示窗口"
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
    cmbProvider.CausesValidation = Flag
    txtPurdate.CausesValidation = Flag
'    txtRtfno.Validation = Flag