VB开发的ERP系统

    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("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)
            '设置CMB状态
            Cmb_LineName.Enabled = False
            Cmb_SiteName.Enabled = False
            Cmb_MName.Enabled = False
            Cmb_BanZu.Enabled = False
            Cmb_SiteTime.Enabled = 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("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)
            '设置CMB状态
            Cmb_LineName.Enabled = True
            Cmb_SiteName.Enabled = True
            Cmb_MName.Enabled = True
            Cmb_BanZu.Enabled = True
            Cmb_SiteTime.Enabled = 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("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)
            '设置CMB状态
            Cmb_LineName.Enabled = True
            Cmb_SiteName.Enabled = True
            Cmb_MName.Enabled = True
            Cmb_BanZu.Enabled = True
            Cmb_SiteTime.Enabled = 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 Sub_CheckStatus()                                       '设置审核弃审按钮状态(亦可设置其他动作按钮状态)
    
    '根据当前单据状态来确定审核弃审按钮状态
    If Trim(LrText(1).Text) <> "" And Trim(LrText(2).Text) = "" Then
        Tlb_Action.Buttons("shsh").Enabled = True      '审核
    Else
        Tlb_Action.Buttons("shsh").Enabled = False     '审核
    End If
    If Trim(LrText(1).Text) <> "" And Trim(LrText(2).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                        '临时使用查询字符串
    
    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 "003"                   '检验结果
                If Trim(.TextMatrix(Dqpdwgh, 1)) = "" Then
                    .TextMatrix(Dqpdwgh, Sydz("003", GridStr(), Szzls)) = ""
                    .TextMatrix(Dqpdwgh, 0) = ""
                End If
                If (Not IsNumeric(Trim(.TextMatrix(Dqpdwgh, Sydz("003", GridStr(), Szzls))))) And Trim(.TextMatrix(Dqpdwgh, Sydz("003", GridStr(), Szzls))) <> "" Then
                    Tsxx = "请输入数字!"
                    GoTo Lrcwcl
                Else
                    .TextMatrix(Dqpdwgh, Sydz("003", GridStr(), Szzls)) = Format(Trim(.TextMatrix(Dqpdwgh, Sydz("003", GridStr(), Szzls))), "###0." + String(4, "0"))
         
                End If
            Case "005"                   '备注
                If Trim(.TextMatrix(Dqpdwgh, 1)) = "" Then
                    .TextMatrix(Dqpdwgh, Sydz("005", GridStr(), Szzls)) = ""
                    .TextMatrix(Dqpdwgh, 0) = ""
                End If
        End Select
        
        
        '字段录入正确后为零字段清空(Fixed)
        Call Qkwlzd(Dqpdwgh, Dqpdwgl)
        
       
        
        '字段有效性判断通过,将字段有效性判断加锁直至再次改变(Fixed)
        sjzdyxxpd = True
        Yxxpdlock = True
        Exit Function
    End With
    
Lrcwcl:    '录入错误处理
    With WglrGrid
        
        '给出错误提示信息
        Call Xtxxts(Tsxx, 0, 1)
        
        '返回网格错误位置(ChangeLock避免再次引发RowColChange有效性判断),装入录入载体
        Changelock = True
        .Select Dqpdwgh, Dqpdwgl
        Changelock = False
        Call xswbk
        
        '函数返回False
        sjzdyxxpd = False
        Exit Function
    End With
    
End Function

Private Function Sjhzyxxpd(ByVal Yxxpdh As Long) As Boolean                     '录入数据行有效性判断,同时进行行处理
    
    '函数参数:Yxxpdh 要进行有效性判断的网格数据行的行值
    
    Dim Lrywlz As Long                            '录入有误网格列值
    Dim RecTemp As New ADODB.Recordset            '临时使用动态集
    
    With WglrGrid
        '判断行为空(行中所有可编辑列数据均为空或为零)和无效数据行则清除当前行
        If .Rows <= .FixedRows Then Exit Function   ' 如果没有记录，则退出
        If .TextMatrix(Yxxpdh, 0) <> "*" Then
            Sjhzyxxpd = True
            Exit Function
        
        End If
        
        '行没有发生变化则不进行有效性判断
        If Hyxxpdlock Then
            Sjhzyxxpd = True
            Exit Function
        End If
        
        '[>>以下为自定义部分
        
        '1.放置行有效性判断程序
        
        '1.1首先进行单个不能为空或不能为零判断(Fixed)
        For Jsqte = Qslz To .Cols - 1
            
            '字段不能为空
            If GridInt(Jsqte, 5) = 1 Then
                If Len(Trim(.TextMatrix(Yxxpdh, Jsqte))) = 0 Then
                    Tsxx = GridStr(Jsqte, 2)
                    Lrywlz = Jsqte
                    GoTo Lrcwcl
                    Exit For
                End If
            End If
            
            '字段不能为零
            If GridInt(Jsqte, 5) = 2 Then
                If Val(Trim(.TextMatrix(Yxxpdh, Jsqte))) = 0 Then
                    Tsxx = GridStr(Jsqte, 2)
                    Lrywlz = Jsqte
                    GoTo Lrcwcl
                    Exit For
                End If
            End If
        Next Jsqte
        
        '1.2进行其他有效性判断,编写格式同1.1
        
        '2.放置行处理程序(当数据行通过有效性判断)
        
        '以上为自定义部分<<]
    End With    'WglrGrid
    
    '如果此行通过行有效性判断则加锁,直至此行数据再次发生变化
    Sjhzyxxpd = True
    Hyxxpdlock = True
    Exit Function
    
Lrcwcl:      '录入错误处理
    With WglrGrid
        
        '给出错误提示信息
        Call Xtxxts(Tsxx, 0, 1)
        
        '返回网格错误位置 (ChangeLock避免再次引发RowColChange有效性判断), 装入录入载体
        Changelock = True
        .Select Yxxpdh, Lrywlz
        Changelock = False