frmchainpdd.frm

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

            Cmd.CommandText = "P_INStoreBill '审核','PSD','" & Trim(txtPurcode.Text) & "'"
            
        Else
            Cmd.CommandText = "P_INStoreBill '弃审','PSD','" & Trim(txtPurcode.Text) & "'"
            
        End If
        Cmd.ActiveConnection = Conn
        Cmd.Execute
        
        
        If cmdToolCommit.Caption = "审核[&O]" Then
            Cmd.CommandText = "P_INChainStoreBill '审核','PSD','" & Trim(txtPurcode.Text) & "'"
            Call SetButtonState(True)
        Else
            Cmd.CommandText = "P_INChainStoreBill '弃审','PSD','" & Trim(txtPurcode.Text) & "'"
            Call SetButtonState(False)
        End If
        Cmd.ActiveConnection = Conn
        Cmd.Execute
    End If
End Sub

Private Sub cmdToolSelect_Click()
    Dim s, ss, Qty, prc, I
    On Error Resume Next
    If txtSuppno.Text = "" Then
        MsgBox "请先选择分店!", vbExclamation, "提示窗口"
        Exit Sub
    End If
    
    Load frmChainSelectGoods
    frmChainSelectGoods.SType = "配送"
    frmChainSelectGoods.ChainCode = txtSuppno.Text
    frmChainSelectGoods.Show 1
    sSQL = "SELECT 品名,单位,进价,零售价,税率,含税进价 FROM 商品主档 WHERE 商品编码='" & frmChainSelectGoods.GCode & "'"
    Set RsTemp = Nothing
    RsTemp.Open sSQL, Conn, adOpenStatic, adLockOptimistic
    
    If RsTemp.EOF Then
        MsgBox "该商品编码不存在!" & vbCrLf & "请检查输入是否正确或查询商品编码.", vbExclamation, "提示窗口"
        Exit Sub
    End If
    
    grdDET.Update
    
    If frmChainSelectGoods.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(frmChainSelectGoods.GCode) & "'"
        Set RsTemp = Nothing
        RsTemp.Open sSQL, Conn, adOpenStatic, adLockReadOnly
        If RsTemp.EOF Then
            MsgBox "该商品编码不存在！" & grdDET.Columns("商品编码").Text & "!", vbExclamation, "提示窗口"
            Exit Sub
        End If
'
'        prc = RsTemp("含税进价")
        
'        Load frmChainPrc
'        Call frmChainPrc.InitData(frmChainSelectGoods.GCode, txtSuppno.Text)
'        frmChainPrc.Show 1
'        prc = frmChainPrc.prc
        
        If GetSetting("LSDSTAR", "库存设置", "配送单加点提示", "1") = "1" Then
            Load frmChainPrc
            Call frmChainPrc.InitData(frmChainSelectGoods.GCode, txtSuppno.Text)
            frmChainPrc.Show 1
            prc = frmChainPrc.prc
        Else
            prc = frmChainSelectGoods.vPrc
        End If

        
        ss = frmChainSelectGoods.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 = frmChainSelectGoods.GCode & vbTab & RsTemp("品名") & vbTab & _
                    RsTemp("单位") & vbTab & s & vbTab & Str(Qty * prc)
            grdDET.AddItem Temp
        Wend
    End If
    Unload frmChainSelectGoods

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