frmchainpddqd.frm

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

       End If
    End If
    Exit Sub
MyErr:
    MsgBox "在移动到下一表单时发生错误,信息:" + Err.Description, vbCritical
End Sub

'上一条记录
Private Sub cmdPrev_Click()
    On Error GoTo MyErr:
    If (Not QueryRs.BOF) Then
       QueryRs.MovePrevious
       If (Not QueryRs.BOF) Then
          RefreshTable (QueryRs("表单号"))
       Else
          Call RefreshTable(" ")
          sb1.Panels(1).Text = "已经到查询结果开头了。"
       End If
    End If
    Exit Sub
MyErr:
    MsgBox "在移动到上一表单时发生错误,信息:" + Err.Description, vbCritical
End Sub


'保存表
Private Sub cmdSave_Click()
    Dim sSQL As String
    On Error GoTo MyErr
    If Not DataIsOK() Then
        MsgBox "数据存在错误!请检查!", vbExclamation, "提示窗口"
        Exit Sub
    End If
    Call CalTotal
    '检查是否存在相同编号供应商编码.
    sSQL = "SELECT * FROM " & TableName & " WHERE 表单号='" & txtPurcode.Text & "'"
    Set RsTemp = Nothing
    Set RsTemp = OpenRS(sSQL)
    '如果存在
    If Not RsTemp.EOF Then
       If (RsTemp("确认状态") = True) Then
          '供应商编码审批表已经确认不允许修改.
          MsgBox "此单据已经确认不允许修改", vbExclamation, "提示窗口"
          Exit Sub
       Else
          '表未确认,允许修改.
          Temp = "此操作将覆盖原来数据,您确认要继续吗?"
          If (MsgBox(Temp, vbYesNo + vbDefaultButton2 + vbQuestion) = vbNo) Then Exit Sub
       End If
    End If
    '否则代销付款单允许修改.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    Cmd.ActiveConnection = Conn
    
    Conn.BeginTrans
    
    If CommSaveTable Then
       '确认事务
       Conn.CommitTrans
       cmdPrev.Enabled = False
       cmdNext.Enabled = False
       cmdDelete.Enabled = True
       '提示
        sb1.Panels(1).Text = "ChainPDDQD已被保存。"
    Else
       '回卷事务
       Conn.RollbackTrans
       '提示
       sb1.Panels(1).Text = "ChainPDDQD保存失败！"
    End If
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    Exit Sub
MyErr:
    Conn.RollbackTrans
    MsgBox "保存失败." + Chr(13) + "原因:" + Err.Description, vbCritical
End Sub

Private Sub cmdToolJian_Click()
    Dim s, ss, Qty, prc, I
    If txtSuppno.Text = "" Then
        MsgBox "请先选择分店!", vbExclamation, "提示窗口"
        Exit Sub
    End If
    Load frmDist
    'Set frmDist.frm = Me
    frmDist.Show 1
    sSQL = "SELECT 品名,单位,进价,零售价,税率,含税进价 FROM 商品主档 WHERE 商品编码='" & frmDist.GCode & "'"
    Set RsTemp = Nothing
    RsTemp.Open sSQL, Conn, adOpenStatic, adLockOptimistic
    
    If RsTemp.EOF Then
        MsgBox "该商品编码不存在!" & vbCrLf & "请检查输入是否正确或查询商品编码.", vbExclamation, "提示窗口"
        Exit Sub
    End If
        If frmDist.R <> "" Then
            
'            sSQL = "select * from 分店商品信息 where 商品编码='" & Trim(grdDET.Columns("商品编码").Text) & "' and 分店编码='" & Trim(txtSuppno.Text) & "'"
'            Set RsTemp = Nothing
'            RsTemp.Open sSQL, Conn, adOpenStatic, adLockOptimistic
'
'            If Not RsTemp.EOF Then prc = RsTemp("配送价")
            
            sSQL = "SELECT * FROM 商品主档 WHERE 商品编码='" & Trim(frmDist.GCode) & "'"
            Set RsTemp = Nothing
            RsTemp.Open sSQL, Conn, adOpenStatic, adLockReadOnly
            If RsTemp.EOF Then
                MsgBox "该商品编码不存在！" & grdDET.Columns("商品编码").Text & "!", vbExclamation, "提示窗口"
                Exit Sub
            End If
            
            Load frmChainPrc
            Call frmChainPrc.InitData(frmDist.GCode, txtSuppno.Text)
            frmChainPrc.Show 1
            prc = frmChainPrc.prc
            
            ss = frmDist.R
            
            I = 1
            While I <= Len(ss)
                s = ""
                Qty = ""
                While Mid(ss, I, 1) <> "#" And I <= Len(ss)
                    If Mid(ss, I, 1) = "@" Then
                        s = s & vbTab
                    ElseIf Mid(ss, I, 1) = "$" Then
                        Qty = ""
                        s = s & vbTab & Str(prc) & vbTab
                    Else
                        Qty = Qty & Mid(ss, I, 1)
                        s = s & Mid(ss, I, 1)
                    End If
                    I = I + 1
                Wend
                I = I + 1
                Temp = frmDist.GCode & vbTab & RsTemp("品名") & vbTab & _
                        RsTemp("单位") & vbTab & s & vbTab & Str(Qty * prc)
                grdDET.AddItem Temp
            Wend
        End If
        Unload frmDist

End Sub



Private Sub Form_Load()
    Dim sSQL As String
    sSQL = "select  * from inf_sys where paraname='配送单价提示' "
    Set RsTemp = Nothing
    Set RsTemp = OpenRS(sSQL)
    sSQL = " select * from localmsg "
    Set RsTemp = Nothing
    Set RsTemp = OpenRS(sSQL)
    If Not RsTemp.EOF Then txtGrpno.Text = RsTemp(1)
    txtIptno.SetConn Conn
    Call RefreshTable(" ")
    Call cmdNew_Click
    
    Cmd.ActiveConnection = Conn
End Sub
'转移焦点
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
    Static KeyFlag As Boolean
    If KeyCode = vbKeyReturn Then SendKeys "{TAB}"
End Sub

Private Sub grdDET_AfterColUpdate(ByVal ColIndex As Integer)
    Call CalTotal
End Sub

Private Sub grdDET_AfterUpdate(RtnDispErrMsg As Integer)
    Call CalTotal
End Sub

Private Sub grdDET_BeforeDelete(Cancel As Integer, DispPromptMsg As Integer)
    DispPromptMsg = False
    If cmdToolCommit.Caption = "弃审[&O]" Then
        Cancel = True
        Exit Sub
    End If
    If (MsgBox("您一定要删除该行数据吗?", vbQuestion + vbYesNo + vbDefaultButton2) = vbNo) Then
       Cancel = True
    End If
    Call CalTotal
End Sub




Private Sub grdDET_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = vbKeyDown Then grdDET.ComboDroppedDown = True
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 grdDET_BeforeColUpdate(ByVal ColIndex As Integer, ByVal OldValue As Variant, Cancel As Integer)
    On Error Resume Next
    Dim sSQL As String
    If QueryFlag Then Exit Sub
    '数据合计
    Select Case Trim(grdDET.Columns(ColIndex).Caption)
      Case "商品编码"
        sSQL = " SELECT sum(数量) FROM 配送中心库存 WHERE 商品编码='" & Trim(grdDET.Columns(0).Text) & "'"
        Set RsTemp = Nothing
        Set RsTemp = OpenRS(sSQL)
        If IsNull(RsTemp(0)) Then
           MsgBox "该商品库存不足！" & grdDET.Columns("商品编码").Text & "!", vbExclamation, "提示窗口"
           grdDET.Columns("数量").Value = 0
           'Cancel = 1
           'Exit Sub
        End If
        
        grdDET.Columns("数量").Value = RsTemp(0)
        sSQL = "SELECT * FROM 商品主档 WHERE 商品编码='" & Trim(grdDET.Columns("商品编码").Text) & "'"
        Set RsTemp = Nothing
        Set RsTemp = OpenRS(sSQL)
        If RsTemp.EOF Then
            MsgBox "该商品编码不存在！" & grdDET.Columns("商品编码").Text & "!", vbExclamation, "提示窗口"
            Cancel = 1
            Exit Sub
        End If
        grdDET.Columns("商品名称").Text = Trim(RsTemp("品名"))
        grdDET.Columns("单位").Text = Trim(RsTemp("单位"))
        grdDET.Columns("单价").Value = RsTemp("进价")
        
        grdDET.Columns("加点").Value = JD
        
        sSQL = "select * from 分店商品信息 where 商品编码='" & Trim(grdDET.Columns("商品编码").Text) & "' and 分店编码='" & Trim(txtSuppno.Text) & "'"
        Set RsTemp = Nothing
        RsTemp.Open sSQL, Conn, adOpenStatic, adLockOptimistic
        If Not RsTemp.EOF Then
            grdDET.Columns("单价").Value = RsTemp("配送价")
        End If

        sSQL = "SELECT 尺寸 FROM 商品信息 where 商品编码='" & Trim(grdDET.Columns("商品编码").Text) & "' group by 尺寸"
        Set RsTemp = Nothing
        RsTemp.Open sSQL, Conn, adOpenStatic, adLockReadOnly
        grdDET.Columns("尺寸").RemoveAll
        While Not RsTemp.EOF
            grdDET.Columns("尺寸").AddItem RsTemp("尺寸")
            RsTemp.MoveNext
        Wend
        sSQL = "SELECT 颜色 FROM 商品信息 where 商品编码='" & Trim(grdDET.Columns("商品编码").Text) & "' group by 颜色 "
        Set RsTemp = Nothing
        RsTemp.Open sSQL, Conn, adOpenStatic, adLockReadOnly
        grdDET.Columns("颜色").RemoveAll
        While Not RsTemp.EOF
            grdDET.Columns("颜色").AddItem RsTemp("颜色")
            RsTemp.MoveNext
        Wend
        
        
        sSQL = "SELECT 进价 FROM LSJHD where 商品编码='" & Trim(grdDET.Columns("商品编码").Text) & "' group by 进价 "
        Set RsTemp = Nothing
        RsTemp.Open sSQL, Conn, adOpenStatic, adLockReadOnly
        grdDET.Columns("进价").RemoveAll
        While Not RsTemp.EOF
            grdDET.Columns("进价").AddItem RsTemp("进价")
            RsTemp.MoveNext
        Wend
        
        

    Case "数量", "单价"
        grdDET.Columns("金额").Text = Format(Val(grdDET.Columns("单价").Text) * Val(grdDET.Columns("数量").Text), "#.00")
        Call CalTotal
    Case "进价", "加点"
        grdDET.Columns("单价").Text = Format(Val(grdDET.Columns("进价").Text) * (Val(grdDET.Columns("加点").Text) / 100 + 1), "#.00")
        grdDET.Columns("金额").Text = Format(Val(grdDET.Columns("单价").Text) * Val(grdDET.Columns("数量").Text), "#.00")
        Call CalTotal
    End Select
End Sub


'进行合计
Private Sub CalTotal()
'    Dim i As Integer
'    txtIamt.Text = "0"
'    txtIamt0.Text = ""
'    grdDET.MoveFirst
'    For i = 0 To grdDET.Rows - 1
'        txtIamt0.Text = CStr(Val(txtIamt0.Text) + Val(grdDET.Columns("数量").CellText(i)))
'        txtIamt.Text = CStr(Val(txtIamt.Text) + Val(grdDET.Columns("金额").CellText(i)))
'        grdDET.MoveNext
'    Next i
'    txtIamt.Text = Format(txtIamt.Text, "#.00")

    Dim vBm As Variant
    Dim Qty, Iamt, Ramt
    Dim I As Integer
    
    vBm = grdDET.Bookmark
    grdDET.MoveFirst
    
    For I = 0 To grdDET.Rows - 1
        Qty = Qty + grdDET.Columns("数量").CellValue(grdDET.GetBookmark(I))
        Ramt = Ramt + grdDET.Columns("金额").CellValue(grdDET.GetBookmark(I))
    Next I
    
    txtIamt0.Text = CStr(Qty)
    txtIamt.Text = CStr(Ramt)
    
    grdDET.Bookmark = vBm

End Sub

Private Sub grdDET_RowColChange(ByVal LastRow As Variant, ByVal LastCol As Integer)
'    Call CalTotal
End Sub


Private Sub txtPurcode_Validate(Cancel As Boolean)
    Dim sSQL As String
    Dim Rs As New ADODB.Recordset
    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 " & TableName & " 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(txtPurcode.Text)
        Else
            txtPurcode.SelStart = 0
            txtPurcode.SelLength = Len(txtPurcode.Text)
            Cancel = True
        End If
    End If
End Sub

'日期格式转换
Private Sub txtPurdate_GotFocus()
    txtPurdate.ZOrder 0
End Sub

Private Sub txtSuppno_CloseUp()
    txtSuppName.Text = txtSuppno.Columns(1).Text
    Set RsTemp = Nothing
    RsTemp.Open "select 电话 from 分店主档 where 分店编码='" & Trim(txtSuppno.Columns(0).Text) & "'", Conn, adOpenStatic, adLockReadOnly
    JD = RsTemp("电话")
End Sub

Private Sub txtSuppno_GotFocus()
    txtSuppno.DroppedDown = True
End Sub

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