frm商品编码.frm

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

    Conn.CommitTrans
    Exit Sub
ComErr:
    ErrNum = Err.number
    MsgBox "确认失败!,请检查数据是否正确!" & vbCrLf & Error$(ErrNum), vbExclamation, "提示窗口"
    Conn.RollbackTrans
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
    cmbProvider.CausesValidation = Flag
'    txtRtfno.Validation = Flag
'    txtRptno.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 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 cmbProvider.Text <> "" Then
        strTemp = strTemp & "  厂商编码" & _
            AnalyseCondition(cmbProvider.Text, True) & " AND "
    End If
'    If txtRtfno.Text <> "" Then
'        strTemp = strTemp & "  审核员" & _
'            AnalyseCondition(txtRtfno.Text, True) & " AND "
'    End If
'    If txtRptno.Text <> "" Then
'        strTemp = strTemp & "  申报员" & _
'            AnalyseCondition(txtRptno.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), True) & " AND "
'    End If
'    If grdDET.Columns(3).CellText(0) <> "" Then
'        strTemp = strTemp & "  单位 " & _
'            AnalyseCondition(grdDET.Columns(3).CellText(0), True) & " AND "
'    End If
'    If grdDET.Columns(4).CellText(0) <> "" Then
'        strTemp = strTemp & "  进价 " & _
'            AnalyseCondition(grdDET.Columns(4).CellText(0), False) & " AND "
'    End If
'    If grdDET.Columns(5).CellText(0) <> "" Then
'        strTemp = strTemp & "  零售价 " & _
'            AnalyseCondition(grdDET.Columns(5).CellText(0), False) & " AND "
'    End If
'    If grdDET.Columns(6).CellText(0) <> "" Then
'        strTemp = strTemp & "  税率 " & _
'            AnalyseCondition(grdDET.Columns(6).CellText(0), False) & " AND "
'    End If
    If strTemp <> "" Then
        '去掉尾部的" AND "
        sSQL = sSQL & " WHERE " & Mid(strTemp, 1, Len(strTemp) - 4)
    End If
    sSQL = sSQL & " GROUP BY 表单号 ORDER BY 表单号"
    GenerateQuerySQL = sSQL
End Function

'查询
Private Sub cmdToolQuery_Click()
    Dim strTemp As String
    TableState = "查询"
    grdDET.AllowUpdate = True
    grdDET.SelectByCell = False
    If cmdToolQuery.Caption = "查询[&Q]" Then
        cmdToolQuery.Caption = "开始[&Q]"
        QueryFlag = True
        Call ShowStatus(1)
        
        cmdToolAdd.Enabled = False
        cmdToolSave.Enabled = False
        cmdToolPrevious.Enabled = False
        cmdToolNext.Enabled = False
        cmdToolDelete.Enabled = False
        cmdToolCommit.Enabled = False
        
        Call SetValidate(False)
        Call ClearTable
        txtPurcode.SetFocus
    ElseIf cmdToolQuery.Caption = "开始[&Q]" Then
        cmdToolQuery.Caption = "查询[&Q]"
        QueryFlag = False
        
        cmdToolAdd.Enabled = True
        cmdToolSave.Enabled = True
        cmdToolPrevious.Enabled = True
        cmdToolNext.Enabled = True
        cmdToolDelete.Enabled = True
        cmdToolCommit.Enabled = True
        
        Call SetValidate(True)

        grdDET.Update
        Call GenerateQuerySQL

        Set Rs = Nothing
        Rs.CursorLocation = adUseClient
        Rs.Open sSQL, Conn, adOpenStatic, adLockOptimistic
        If Rs.EOF Then
            MsgBox "无匹配记录!", vbInformation, "提示窗口"
            cmdToolPrevious.Enabled = False
            cmdToolNext.Enabled = False
            Exit Sub
        End If
        sSQL = "SELECT * FROM 审价单 WHERE 表单号='" & Trim(Rs(0)) & "'"
        Set RsTemp = Nothing
        RsTemp.Open sSQL, Conn, adOpenStatic, adLockPessimistic
        Call RefreshTable(RsTemp)
        Call ShowStatus(0)
    End If
End Sub


'下一条记录
Private Sub cmdToolNext_Click()
    On Error Resume Next
    If Rs.State = adStateClosed Then Exit Sub
    If Not Rs.EOF Then
        Rs.MoveNext
        Call ShowStatus(0)
        If Not Rs.EOF Then
            sSQL = "SELECT * FROM 审价单 WHERE 表单号='" & Trim(Rs(0)) & "'"
            Set RsTemp = Nothing
            RsTemp.Open sSQL, Conn, adOpenStatic, adLockReadOnly
            
            Call RefreshTable(RsTemp)
        Else
            Call ClearTable
        End If
    End If
End Sub

'上一条记录
Private Sub cmdToolPrevious_Click()
    On Error Resume Next
    If Rs.State = adStateClosed Then Exit Sub
    If Not Rs.BOF Then
        Rs.MovePrevious
        Call ShowStatus(0)
        If Not Rs.BOF Then
            sSQL = "SELECT * FROM 审价单 WHERE 表单号='" & Trim(Rs(0)) & "'"
            Set RsTemp = Nothing
            RsTemp.Open sSQL, Conn, adOpenStatic, adLockReadOnly
            
            Call RefreshTable(RsTemp)
        Else
            Call ClearTable
        End If
    End If
End Sub

'刷新表
Private Sub cmdToolSave_Click()
    On Error GoTo RefErr
    If Not DataOK() Then
        MsgBox "数据存在错误!请检查!", vbExclamation, "提示窗口"
        Exit Sub
    End If
   
    Conn.BeginTrans
    Call ShowStatus(3)
    '开始事务
    sSQL = "SELECT * FROM 审价单 WHERE 表单号='" & txtPurcode.Text & "'"
    Set RsTemp = Nothing
    Set RsTemp = OpenRS(sSQL)
    If Not RsTemp.EOF Then
        Temp = "该表单已经存在，覆盖原表单吗？"
        Temp = MsgBox(Temp, vbOKCancel, "提示窗口")
        If Temp = vbCancel Then
            Conn.RollbackTrans
            Exit Sub
        End If

        '生成SQL语句,删除表头旧数据
        sSQL = "DELETE  FROM " & TableName & " WHERE 表单号='" & txtPurcode.Text & "'"
        If RunSQL(sSQL) <> 0 Then
            MsgBox "更新失败!请检查数据的合法性!" & vbCrLf & Error$(ErrNum), vbExclamation, "警告窗口"
            Conn.RollbackTrans
            Exit Sub
        End If
        
    End If
    If SaveTable() Then
        '确认事务
        Conn.CommitTrans
        cmdToolPrevious.Enabled = False
        cmdToolCommit.Enabled = True
        cmdToolNext.Enabled = False
        cmdToolDelete.Enabled = True
    Else
        Temp = "在对数据库进行写操作时发生错误!" & vbCrLf & _
        "请检查是否存在重复的编码或编码格式是否正确!"
        MsgBox Temp, vbExclamation + vbOKOnly, "错误提示窗口"
        '事务回卷
        Conn.RollbackTrans
    End If
    Exit Sub
RefErr:
    ErrNum = Err.number
    MsgBox "更新数据库发生错误!" & vbCrLf & Error$(ErrNum), vbExclamation, "提示窗口"
End Sub

'转移焦点
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = vbKeyReturn Then SendKeys "{TAB}"
End Sub


Private Sub Form_Load()
    Call SetFormToCenter(Me)
'    txtRtfno.SetConn Conn
'    txtRtfno.TableName = ClerkInfo
'    txtRtfno.CodeField = ClerkCode
'    txtRtfno.NameField = ClerkName
'    txtRptno.SetConn Conn
'    txtRptno.TableName = ClerkInfo
'    txtRptno.CodeField = ClerkCode
'    txtRptno.NameField = ClerkName
    txtIptno.SetConn Conn
    txtIptno.TableName = ClerkInfo
    txtIptno.CodeField = ClerkCode
    txtIptno.NameField = ClerkName
    
    grdDET.Columns("含税进价").NumberFormat = DecNum
    grdDET.Columns("不含税进价").NumberFormat = DecNum
    grdDET.Columns("零售价").NumberFormat = DecNum

    
    Call cmdToolAdd_Click
    txtPurcode.Text = GeneratePurcode(TableName)
    txtIptno.Text = UserCode

End Sub



Private Sub Form_Unload(Cancel As Integer)
    Set Rs = Nothing
End Sub

Private Sub grdDET_BeforeDelete(Cancel As Integer, DispPromptMsg As Integer)
    DispPromptMsg = False
    If (MsgBox("您一定要删除选定行数据吗?", vbQuestion + vbYesNo + vbDefaultButton2) = vbNo) Then
        Cancel = True
    End If
End Sub
'判断商品编码是否已经存在
'进行数据合计
Private Sub grdDET_BeforeColUpdate(ByVal ColIndex As Integer, ByVal OldValue As Variant, Cancel As Integer)
    On Error GoTo FormatErr
    If QueryFlag Then Exit Sub
    Select Case grdDET.Columns(ColIndex).Name
        Case "商品编码" 'If ColIndex = 0 Then
'        '进行数据合法性检查
'        sSQL = "SELECT 本节点编码 FROM 商品分类表 WHERE 级别=2 " & _
'            " AND 本节点编码='" & Mid(grdDET.Columns(0).Text, 1, 1) & "' AND 父节点名称 IN " & _
'            " (SELECT 本节点名称 FROM 商品分类表 WHERE 级别=1" & _
'            " AND 本节点编码='" & Mid(grdDET.Columns(0).Text, 1, 1) & "')"
'        Set RsTemp = Nothing
'        RsTemp.Open sSQL, Conn, adOpenStatic, adLockReadOnly
'        If RsTemp.EOF Then
'            MsgBox "不存在该编码的分类信息!!!", vbExclamation, "错误窗口"
'            Cancel = 1
'        Else
'            Cancel = 0
'        End If
'        If Len(grdDET.Columns(0).Text) <> 9 Then
'            MsgBox "编码长度不足9位!!!", vbExclamation, "错误窗口"
'            Cancel = 1
'        End If

        sSQL = "SELECT * FROM 商品主档 WHERE 商品编码='" & Trim(grdDET.Columns("商品编码").Text) & "'"
        Set RsTemp = Nothing
        RsTemp.Open sSQL, Conn, adOpenStatic, adLockReadOnly
        If Not RsTemp.EOF Then
            MsgBox "已存在该商品编码!!!", vbExclamation, "错误窗口"
            Cancel = 1
        End If

'        If Mid(grdDET.Columns(0).Text, 1, 2) <> Trim(cmbProvider.Text) Then
'            MsgBox "商品编码与厂商不符!!,前两位应为厂商编码!!", vbInformation, "提示窗口"
'            Cancel = 1
'            Exit Sub
'        End If
'        sSQL = "SELECT * FROM COLOR WHERE COLORCODE='" & Mid(grdDET.Columns(0).Text, 8, 2) & "'"
'        Set RsTemp = Nothing
'        RsTemp.Open sSQL, Conn, adOpenStatic, adLockReadOnly
'        If RsTemp.EOF Then
'            MsgBox "颜色编码错误，未找到相应编码!!", vbInformation, "提示窗口"
'            Cancel = 1
'            Exit Sub
'        End If
        
        grdDET.Columns("单位").Text = "双"
        Case "不含税进价" 'ElseIf ColIndex = 6 Then
            grdDET.Columns("含税进价").Value = Format((1 + grdDET.Columns("税率").Value / 100) * grdDET.Columns("不含税进价").Value, DecNum)
        Case "税率", "含税进价" 'ElseIf ColIndex = 5 Then
            grdDET.Columns("不含税进价").Value = Format(grdDET.Columns("含税进价").Value / (1 + grdDET.Columns("税率").Value / 100), DecNum)
            'grdDET.Columns("含税进价").Value = (1 + grdDET.Columns("税率").Value / 100) * grdDET.Columns("不含税进价").Value
        Case "含税进价" 'ElseIf ColIndex = 4 Then
'            grdDET.Columns("不含税进价").Value = Format(grdDET.Columns("含税进价").Value / (1 + grdDET.Columns("税率").Value / 100), DecNum)
    End Select
    Exit Sub
FormatErr:
    ErrNum = Err.number
    Cancel = 1
End Sub

Private Sub txtIptno_GotFocus()
    If Not QueryFlag Then SendKeys "{TAB}"
End Sub

Private Sub txtIptno_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = vbKeyReturn Then SendKeys "{TAB}"
End Sub


Private Sub txtPurcode_Validate(Cancel As Boolean)
    If QueryFlag Then Exit Sub
    If TableState <> "新建" Then Exit Sub
    If Len(txtPurcode.Text) <> 7 Then
        MsgBox "表单号位数不够！", vbExclamation, "提示窗口"
        Cancel = True
        Exit Sub
    End If

    sSQL = "SELECT * FROM 审价单 WHERE 表单号='" & txtPurcode.Text & "'"
    Set RsTemp = OpenRS(sSQL)
    '记录集为空则退出
    If RsTemp.EOF Then
        Cancel = False
        Exit Sub
    ElseIf grdDET.Rows = 0 Then
        Temp = "该表单已经存在!" & vbCrLf & "显示该表单吗?"
        Temp = MsgBox(Temp, vbExclamation + vbYesNo, "提示窗口")
        If Temp = vbYes Then
            Set Rs = Nothing
            Set Rs = RsTemp
            Call RefreshTable(Rs)
        Else
            txtPurcode.SelStart = 0
            txtPurcode.SelLength = Len(txtPurcode.Text)
            Cancel = True
        End If
    End If
End Sub


Private Sub txtPurdate_Validate(Cancel As Boolean)
    Dim t
    On Error GoTo DateErr
    t = CDate(txtPurdate.Text)
    txtPurdate.Text = Format(txtPurdate.Text, "yyyy-mm-dd")
    Cancel = False
    Exit Sub
DateErr:
    Cancel = True
End Sub