VB开发的ERP系统

            Call Sub_JH
        Case "jz"                                            '记帐
            Call Sub_JZ
        Case "re"                                            '恢复
            Call REJZ
        Case "sx"                                          '下 张
            Call Sub_Sx
        Case "choice"                                          '末 张
            If LrText(1).Tag = "" Then
                Tsxx = "请选择仓库!"
                Call Xtxxts(Tsxx, 0, 1)
                LrText(1).SetFocus
                Exit Sub
            End If
            KF_FrmMateChoice.Show 1
            Call fillmate
        Case "bz"                                            '帮 助
            Call F1bz
        Case "fh"                                            '退 出
            Unload Me
    End Select
       
    '解 锁
    Valilock = False
    Changelock = False
    TextChangeLock = False
        
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
        Select Case Str_Status
            Case "10"   '浏览((列表)调入单据处理时的进入状态、(列表)新增状态时放弃录入)
                '工具条
                .Buttons("dy").Enabled = True       '打印
                .Buttons("yl").Enabled = True       '预览
                .Buttons("xz").Enabled = True       '新增
                .Buttons("xg").Enabled = True       '修改
                .Buttons("sc").Enabled = True       '删除
                .Buttons("zh").Enabled = False      '增行
                .Buttons("sh").Enabled = False      '删行
                .Buttons("bc").Enabled = False      '保存
                .Buttons("fq").Enabled = False      '放弃
                .Buttons("pk").Enabled = False    '盘库
                .Buttons("choice").Enabled = False    '选择
                If S2N(Lab_BillId.Caption) <> 0 Then
                    .Buttons("zb").Enabled = True 'Not Label1.Visible
                    If LrText(8).Text = "" Then
                        .Buttons("jz").Enabled = Not .Buttons("jh").Enabled
                        If .Buttons("jh").Enabled Then
                            .Buttons("re").Enabled = Not .Buttons("jh").Enabled
                        Else
                            .Buttons("re").Enabled = Not .Buttons("jz").Enabled
                        End If
                    Else
                        .Buttons("jz").Enabled = False
                        .Buttons("re").Enabled = Not .Buttons("jz").Enabled
                    End If
                Else
                    .Buttons("zb").Enabled = False
                    .Buttons("jh").Enabled = False
                    .Buttons("jz").Enabled = False
                End If
                If Not .Buttons("jz").Enabled Then
                    Label1.Visible = False
                End If
                     '记帐
                    '恢复
                .Buttons("sx").Enabled = False
                .Buttons("bz").Enabled = True       '帮助
                .Buttons("fh").Enabled = True       '退出
        
                '设置审核弃审按钮状态
        
                '设置文本框录入状态
                Call Sub_LrtextStatus(False)
            Case "20"   '新增单据(（录入）新增一张单据 、（列表）新增一张单据)
                '工具条
                .Buttons("dy").Enabled = False      '打印
                .Buttons("yl").Enabled = False      '预览
                .Buttons("xz").Enabled = False      '新增
                .Buttons("xg").Enabled = False      '修改
                .Buttons("sc").Enabled = False      '删除
                .Buttons("zh").Enabled = True       '增行
                .Buttons("sh").Enabled = True       '删行
                .Buttons("bc").Enabled = True       '保存
                .Buttons("fq").Enabled = True       '放弃
                .Buttons("pk").Enabled = True    '盘库
                .Buttons("choice").Enabled = True    '选择
                .Buttons("zb").Enabled = False   '制表
                .Buttons("jh").Enabled = False    '激活
                .Buttons("jz").Enabled = False    '记帐
                .Buttons("re").Enabled = False    '恢复
                .Buttons("sx").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("sc").Enabled = False      '删除
                .Buttons("zh").Enabled = True       '增行
                .Buttons("sh").Enabled = True       '删行
                .Buttons("bc").Enabled = True       '保存
                .Buttons("fq").Enabled = True       '放弃
                .Buttons("pk").Enabled = True    '盘库
                .Buttons("choice").Enabled = True    '选择
                .Buttons("zb").Enabled = False   '制表
                .Buttons("jh").Enabled = False    '激活
                .Buttons("jz").Enabled = False    '记帐
                .Buttons("re").Enabled = False    '恢复
                .Buttons("sx").Enabled = False
                .Buttons("bz").Enabled = True       '帮助
                .Buttons("fh").Enabled = True       '退出
                
                '设置文本框录入状态
                Call Sub_LrtextStatus(True)
        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 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                        '临时使用查询字符串

    With WglrGrid
        '非录入状态或非数据行则其有效性为合法
        If Yxxpdlock Or .Row < .FixedRows Then
            sjzdyxxpd = True
            Exit Function
        End If
        
        '取得当前要判断字段内容
        Str_JudgeText = Trim(.TextMatrix(Dqpdwgh, Dqpdwgl))
        jsqr = Dqpdwgh
        '根据不同字段进行相应的处理(依据其逻辑编号)
        Select Case GridStr(Dqpdwgl, 1)
            '[>>以下为自定义部分
            Case "001"                   '物料编码
               If Not Trim(Str_JudgeText) = "" Then
                    '1.放置字段有效性判断
                Sqlstr = "SELECT MNumber,MName,Model,PrimaryUnit,PrimaryUnitName,Ispcgl,Isbzqgl,planprice From Gy_Material Where stopflag=0 and MNumber='" & Trim(Str_JudgeText) & "' Or MName='" & Trim(Str_JudgeText) & "'"
                    Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
                    If RecTemp.EOF Then
                        Tsxx = "此物料编码不存在!"
                        GoTo Lrcwcl
                    Else
                        '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)) = Trim(RecTemp.Fields("PrimaryUnitName") & "")
                        .TextMatrix(Dqpdwgh, 2) = RecTemp.Fields("Ispcgl")
                        .TextMatrix(Dqpdwgh, 3) = RecTemp.Fields("Isbzqgl")
                        
                        If PriceMode = "计划价法" And S2N(RecTemp.Fields("PlanPrice")) <> 0 Then
                            .TextMatrix(Dqpdwgh, Sydz("010", GridStr(), Szzls)) = S2N(RecTemp.Fields("PlanPrice"))
                        End If
                        
                        If NowQuan(Trim(LrText(1).Tag), Trim(.TextMatrix(Dqpdwgh, 1)), Trim(.TextMatrix(Dqpdwgh, Sydz("006", GridStr(), Szzls))), Trim(.TextMatrix(Dqpdwgh, Sydz("001", GridStr(), Szzls)))) <> 0 Then
                            .TextMatrix(Dqpdwgh, Sydz("007", GridStr(), Szzls)) = NowQuan(Trim(LrText(1).Tag), Trim(.TextMatrix(Dqpdwgh, 1)), Trim(.TextMatrix(Dqpdwgh, Sydz("006", GridStr(), Szzls))), Trim(.TextMatrix(Dqpdwgh, Sydz("001", GridStr(), Szzls))))
                        End If
                    End If
                    '根据公式计算结果
                        Call Sub_JoinCount(Dqpdwgh, Sydz("008", GridStr(), Szzls))
                        Call Sub_JoinCount(Dqpdwgh, Sydz("011", GridStr(), Szzls))
                        Call Sub_JoinCount(Dqpdwgh, Sydz("013", GridStr(), Szzls))
                Else
                    '3.清空相关字段
                    .TextMatrix(Dqpdwgh, Sydz("002", GridStr(), Szzls)) = ""                                             '物料名称
                    .TextMatrix(Dqpdwgh, Sydz("003", GridStr(), Szzls)) = ""                                             '物料规格型号
                    .TextMatrix(Dqpdwgh, Sydz("004", GridStr(), Szzls)) = ""
                    .TextMatrix(Dqpdwgh, Sydz("010", GridStr(), Szzls)) = ""
                End If
    
            Case "005"      '货区
                '1.放置字段有效性判断
                '2.放置字段事后处理程序
                If Not Trim(Str_JudgeText) = "" Then
                  Sqlstr = "SELECT MArea,MAreaName From KF_Marea Where (MArea='" & Trim(Str_JudgeText) & "' Or MAreaName='" & Trim(Str_JudgeText) & "') and whcode='" & Trim(LrText(1).Tag) & "' and endflag=1"
                    Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
                        If RecTemp.EOF Then
                            Tsxx = "此货区不存在或不属于本仓库或不是末级货区!"
                            GoTo Lrcwcl
                        End If
                        .TextMatrix(Dqpdwgh, Sydz("005", GridStr(), Szzls)) = Trim(RecTemp.Fields("MAreaName") & "")
                        .TextMatrix(Dqpdwgh, 1) = Trim(RecTemp.Fields("MArea") & "")
                End If
                '从现存量中提取数据
                If NowQuan(Trim(LrText(1).Tag), Trim(.TextMatrix(Dqpdwgh, 1)), Trim(.TextMatrix(Dqpdwgh, Sydz("006", GridStr(), Szzls))), Trim(.TextMatrix(Dqpdwgh, Sydz("001", GridStr(), Szzls)))) <> 0 Then
                    .TextMatrix(Dqpdwgh, Sydz("007", GridStr(), Szzls)) = NowQuan(Trim(LrText(1).Tag), Trim(.TextMatrix(Dqpdwgh, 1)), Trim(.TextMatrix(Dqpdwgh, Sydz("006", GridStr(), Szzls))), Trim(.TextMatrix(Dqpdwgh, Sydz("001", GridStr(), Szzls))))
                End If
            Case "006"      '批次
                 If Trim(.TextMatrix(Dqpdwgh, 0)) = "*" Then
                     If Trim(.TextMatrix(Dqpdwgh, Sydz("001", GridStr(), Szzls))) = "" Then
                        Tsxx = "请先输入物料!"
                        Dqpdwgl = Sydz("001", GridStr(), Szzls)
                        GoTo Lrcwcl
                     End If
                    '先输入货区
                    If conArea = 1 Then
                        If Not .ColHidden(Sydz("005", GridStr(), Szzls)) Then
                            If Trim(.TextMatrix(Dqpdwgh, Sydz("005", GridStr(), Szzls))) = "" Then
                                Tsxx = "请先输入货区!"
                                Dqpdwgl = Sydz("005", GridStr(), Szzls)
                                GoTo Lrcwcl
                            End If
                        End If
                    End If
                    '从现存量中提取数据
                    If NowQuan(Trim(LrText(1).Tag), Trim(.TextMatrix(Dqpdwgh, 1)), Trim(.TextMatrix(Dqpdwgh, Sydz("006", GridStr(), Szzls))), Trim(.TextMatrix(Dqpdwgh, Sydz("001", GridStr(), Szzls)))) <> 0 Then
                        .TextMatrix(Dqpdwgh, Sydz("007", GridStr(), Szzls)) = NowQuan(Trim(LrText(1).Tag), Trim(.TextMatrix(Dqpdwgh, 1)), Trim(.TextMatrix(Dqpdwgh, Sydz("006", GridStr(), Szzls))), Trim(.TextMatrix(Dqpdwgh, Sydz("001", GridStr(), Szzls))))
                    End If
                    If S2N(WglrGrid.TextMatrix(jsq, Sydz("008", GridStr(), Szzls)) & "") - S2N(.TextMatrix(Dqpdwgh, Sydz("007", GridStr(), Szzls)) & "") <> 0 Then
                        WglrGrid.TextMatrix(jsq