VB开发的ERP系统

End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)     '支持热键操作
    
    Select Case KeyCode
        Case vbKeyF5          '增加单据
            If Tlb_Action.Buttons("xz").Enabled And Tlb_Action.Buttons("xz").Visible Then
                Call Sub_AddBill
            End If
        Case vbKeyF3          '修改单据
            If Tlb_Action.Buttons("xg").Enabled And Tlb_Action.Buttons("xg").Visible Then
                Call Sub_EditBill
            End If
        Case vbKeyF6          '保存单据
            If Tlb_Action.Buttons("bc").Enabled And Tlb_Action.Buttons("bc").Visible Then
                If Fun_Drfrmyxxpd Then Call Sub_SaveBill
            End If
    End Select

End Sub

Private Sub Sub_OperStatus(Str_Status As String)                 '工具条依据不同状态所进行的变化
    
    With Tlb_Action
        XsFlag.Enabled = False
        
        Select Case Str_Status
            Case "10"   '浏览((列表)调入单据处理时的进入状态、(列表)新增状态时放弃录入)
                '工具条
                .Buttons("dy").Enabled = True       '打印
                .Buttons("yl").Enabled = True       '预览
                .Buttons("xz").Enabled = True       '新增
                .Buttons("xg").Enabled = True       '修改
                .Buttons("Disp").Enabled = True     '回执
                .Buttons("sc").Enabled = True       '删除
                .Buttons("zh").Enabled = False      '增行
                .Buttons("sh").Enabled = False      '删行
                .Buttons("bc").Enabled = False      '保存
                .Buttons("fq").Enabled = False      '放弃
                .Buttons("first").Enabled = True    '首张
                .Buttons("prev").Enabled = True     '上张
                .Buttons("next").Enabled = True     '下张
                .Buttons("last").Enabled = True     '末张
                .Buttons("bz").Enabled = True       '帮助
                .Buttons("fh").Enabled = True       '退出
        
                '设置审核弃审按钮状态
                Call Sub_CheckStatus
        
                '设置文本框录入状态
                Call Sub_LrtextStatus(False)
            Case "20"   '新增单据(（录入）新增一张单据 、（列表）新增一张单据)
                '工具条
                .Buttons("dy").Enabled = False      '打印
                .Buttons("yl").Enabled = False      '预览
                .Buttons("xz").Enabled = False      '新增
                .Buttons("xg").Enabled = False      '修改
                .Buttons("Disp").Enabled = False    '回执
                .Buttons("sc").Enabled = False      '删除
                .Buttons("zh").Enabled = True       '增行
                .Buttons("sh").Enabled = True       '删行
                .Buttons("bc").Enabled = True       '保存
                .Buttons("fq").Enabled = True       '放弃
                .Buttons("shsh").Enabled = False    '审核
                .Buttons("shqs").Enabled = False    '弃审
                .Buttons("first").Enabled = False   '首张
                .Buttons("prev").Enabled = False    '上张
                .Buttons("next").Enabled = False    '下张
                .Buttons("last").Enabled = False    '末张
                .Buttons("bz").Enabled = True       '帮助
                .Buttons("fh").Enabled = True       '退出
                
                '设置文本框录入状态
                Call Sub_LrtextStatus(True)
            Case "30"   '修改(（录入）调入修改功能、（列表）调入修改功能)
                '工具条
                .Buttons("dy").Enabled = False      '打印
                .Buttons("yl").Enabled = False      '预览
                .Buttons("xz").Enabled = False      '新增
                .Buttons("xg").Enabled = False      '修改
                .Buttons("Disp").Enabled = False    '回执
                .Buttons("sc").Enabled = False      '删除
                .Buttons("zh").Enabled = True       '增行
                .Buttons("sh").Enabled = True       '删行
                .Buttons("bc").Enabled = True       '保存
                .Buttons("fq").Enabled = True       '放弃
                .Buttons("shsh").Enabled = False    '审核
                .Buttons("shqs").Enabled = False    '弃审
                .Buttons("first").Enabled = False   '首张
                .Buttons("prev").Enabled = False    '上张
                .Buttons("next").Enabled = False    '下张
                .Buttons("last").Enabled = False    '末张
                .Buttons("bz").Enabled = True       '帮助
                .Buttons("fh").Enabled = True       '退出
                
                '设置文本框录入状态
                If Trim(Lab_Djclzt.Caption) <> "4" Then
                    Call Sub_LrtextStatus(True)
                End If
        End Select
    End With

End Sub

Private Sub Sub_LrtextStatus(TextEnabled As Boolean)                            '设置录入文本框状态

    '录入文本框状态设置
    If TextEnabled Then
        For Jsqte = Max_Text_Index To 0 Step -1
            '判断文本框是否可编辑
            If Textboolean(Jsqte, 5) Then
                LrText(Jsqte).Enabled = True
            Else
                LrText(Jsqte).Enabled = False
            End If
        Next Jsqte
    Else
        For Jsqte = Max_Text_Index To 0 Step -1
            LrText(Jsqte).Enabled = False
        Next Jsqte
    End If

End Sub

Private Sub Sub_CheckStatus()                                       '设置审核弃审按钮状态(亦可设置其他动作按钮状态)
    
    '根据当前单据状态来确定审核弃审按钮状态
    If Trim(LrText(16).Text) <> "" And Trim(LrText(17).Text) = "" Then
        Tlb_Action.Buttons("shsh").Enabled = True      '审核
    Else
        Tlb_Action.Buttons("shsh").Enabled = False   '审核
    End If
    If Trim(LrText(16).Text) <> "" And Trim(LrText(17).Text) <> "" Then
        Tlb_Action.Buttons("shqs").Enabled = True      '弃审
    Else
        Tlb_Action.Buttons("shqs").Enabled = False   '弃审
    End If

End Sub

Private Sub Wbkcl()                                                 '文本框录入之前处理(根据实际情况)
    
    Dim xswbrr As String
    With WglrGrid
        Zdlrqnr = Trim(.Text)
        xswbrr = Trim(.Text)
        If GridBoolean(.Col, 3) Then   '列表框录入
            '填充列表框程序
            Call FillCombo(YdCombo, GridStr(.Col, 5), xswbrr, 0)
        Else
            Wbkbhlock = True
       
            '====以下为用户自定义
            Ydtext.Text = xswbrr
            '====以上为用户自定义
         
            Wbkbhlock = False
            Ydtext.SelStart = Len(Ydtext.Text)
        End If
    End With

End Sub

Private Function sjzdyxxpd(Dqpdwgh As Long, Dqpdwgl As Long) As Boolean       '录入数据字段有效性判断,同时进行字段录入事后处理
 
    '函数参数:Dqpdwgh, Dqpdwgl 当前要判断网格单元所处行列值

    Dim Str_JudgeText As String                 '临时有效性判断字段内容
    Dim Coljsq As Long                          '临时列计数器
    Dim RecTemp As New ADODB.Recordset          '临时使用动态集
    Dim Sqlstr As String                        '临时使用查询字符串
    Dim Jsq As Integer

    With WglrGrid
        '非录入状态或非数据行则其有效性为合法
        If Yxxpdlock Or .Row < .FixedRows Then
            sjzdyxxpd = True
            Exit Function
        End If
        
        '取得当前要判断字段内容
        Str_JudgeText = Trim(.TextMatrix(Dqpdwgh, Dqpdwgl))
      
        '根据不同字段进行相应的处理(依据其逻辑编号)
        Select Case GridStr(Dqpdwgl, 1)
            '[>>以下为自定义部分
            Case "001"                   '货物编码
                If Not Trim(Str_JudgeText) = "" Then
                    '1.放置字段有效性判断
                    Sqlstr = "SELECT * From xs_v_Material Where mnumber='" & Str_JudgeText & "' Or MName='" & Str_JudgeText & "'"
                    Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
                    If RecTemp.EOF Then
                        Tsxx = "此货物不存在!"
                        GoTo Lrcwcl
                    Else
                        If RecTemp.Fields("issale") = 0 Or RecTemp.Fields("StopFlag") = 1 Then
                            Tsxx = "此货物不具销售属性或被停用!"
                            GoTo Lrcwcl
                        End If
                    End If
                    For Jsq = .FixedRows To .Cols - 1
                        If .TextMatrix(Jsq, 0) <> "*" Then
                            Exit For
                        End If
                        If Jsq <> Dqpdwgh Then
                            If Trim(.TextMatrix(Jsq, Sydz("001", GridStr(), Szzls))) = Trim(.TextMatrix(Dqpdwgh, Sydz("001", GridStr(), Szzls))) Then
                                Tsxx = "不能重复录入货物!"
                                GoTo Lrcwcl
                            End If
                        End If
                    Next
                    '2.放置字段事后处理程序
                    .TextMatrix(Dqpdwgh, Sydz("001", GridStr(), Szzls)) = Trim(RecTemp.Fields("Mnumber") & "")      '货物编码
                    .TextMatrix(Dqpdwgh, Sydz("002", GridStr(), Szzls)) = Trim(RecTemp.Fields("MName") & "")        '货物名称
                    .TextMatrix(Dqpdwgh, Sydz("003", GridStr(), Szzls)) = Trim(RecTemp.Fields("Model") & "")        '规格型号
                    .TextMatrix(Dqpdwgh, Sydz("004", GridStr(), Szzls)) = RecTemp.Fields("PrimaryUnitName")         '单位
                    .TextMatrix(Dqpdwgh, Sydz("013", GridStr(), Szzls)) = RecTemp.Fields("cess") / 100              '税率
                    If Trim(LrText(13).Text) <> "" Then
                        If Trim(LrText(13).Tag) Then
                            .TextMatrix(Dqlrwgh, Sydz("008", GridStr(), Szzls)) = RecTemp!consultprice * Val(LrText(13).Text)     '含税单价
                        Else
                            .TextMatrix(Dqlrwgh, Sydz("008", GridStr(), Szzls)) = RecTemp!consultprice / Val(LrText(13).Text)     '含税单价
                        End If
                    Else
                        .TextMatrix(Dqlrwgh, Sydz("008", GridStr(), Szzls)) = RecTemp!consultprice      '含税单价
                    End If
                    .TextMatrix(Dqlrwgh, 1) = RecTemp!consultcost       '参考成本
                    '根据公式计算结果
                    Call Sub_JoinCount(Dqpdwgh, Sydz("008", GridStr(), Szzls))   '单价
                Else
                    '3.清空相关字段
                    .TextMatrix(Dqpdwgh, Sydz("001", GridStr(), Szzls)) = ""      '货物编码
                    .TextMatrix(Dqpdwgh, Sydz("002", GridStr(), Szzls)) = ""      '货物名称
                    .TextMatrix(Dqpdwgh, Sydz("003", GridStr(), Szzls)) = ""      '规格型号
                    .TextMatrix(Dqpdwgh, Sydz("004", GridStr(), Szzls)) = ""      '单位
                    .TextMatrix(Dqpdwgh, Sydz("008", GridStr(), Szzls)) = ""      '含税单价
                    .TextMatrix(Dqpdwgh, Sydz("013", GridStr(), Szzls)) = ""      '税率
                    .TextMatrix(Dqlrwgh, 1) = ""            '参考成本

                End If
            Case "005"          '发货数量
                '1.放置字段有效性判断
                If Not Trim(Str_JudgeText) = "" Then
                    If Val(.TextMatrix(Dqpdwgh, Sydz("005", GridStr(), Szzls))) < 0 Then
                        Tsxx = "发货数量必须大于等于0!"
                        Lrywlz = Sydz("005", GridStr(), Szzls)
                        GoTo Lrcwcl
                    End If
                    If Not IsNumeric(Trim(.TextMatrix(Dqpdwgh, Sydz("005", GridStr(), Szzls)))) Then
                        Tsxx = "数据格式有误!"
                        Lrywlz = Sydz("005", GridStr(), Szzls)
                        GoTo Lrcwcl
                    End If
                End If
                If Lab_Djclzt.Caption <> "4" Then
                    If Not Trim(Str_JudgeText) = "" Then
                        .TextMatrix(Dqpdwgh, Sydz("007", GridStr(), Szzls)) = .TextMatrix(Dqpdwgh, Sydz("005", GridStr(), Szzls))
                    Else
                        .TextMatrix(Dqpdwgh, Sydz("007", GridStr(), Szzls)) = ""            '实收数量
                    End If
    
                    '2.放置字段事后处理程序
                    Call Sub_JoinCount(Dqpdwgh, Sydz("007", GridStr(), Szzls))   '实收数量
                End If
                
            Case "007"          '实收数量
                '1.放置字段有效性判断
                If Not Trim(Str_JudgeText) = "" Then
                    If Val(.TextMatrix(Dqpdwgh, Sydz("007", GridStr(), Szzls))) < 0 Then
                        Tsxx = "实收数量必须大于等于0!"
                        Lrywlz = Sydz("007", GridStr(), Szzls)
                        GoTo Lrcwcl
                    End If
                    If Not IsNumeric(Trim(.TextMatrix(Dqpdwgh, Sydz("007", GridStr(), Szzls)))) Then
                        Tsxx = "数据格式有误!"
                        Lrywlz = Sydz("007", GridStr(), Szzls)
                        GoTo Lrcwcl
                    End If
                End If

                '2.放置字段事后处理程序
                Call Sub_JoinCount(Dqpdwgh, Sydz("007", GridStr(), Szzls))   '发货数量
            
            Case "008"          '含税单价
                If Not Trim(Str_JudgeText) = "" Then
                    If Val(.TextMatrix(Dqpdwgh, Sydz("008", GridStr(), Szzls))) < 0 Then
                        Tsxx = "含税单价必须大于等于0!"
                        Lrywlz = Sydz("008", GridStr(), Szzls)
                        GoTo Lrcwcl
                    End If
                    If Not IsNumeric(Trim(.TextMatrix(Dqpdwgh, Sydz("008", GridStr(), Szzls)))) Then
                        Tsxx = "数据格式有误!"
                        Lrywlz = Sydz(