VB开发的ERP系统

            WglrGrid.TextMatrix(Jsqte, Sydz("002", GridStr(), Szzls)) = Trim(.Fields("MName") & "")                    '存货名称
            WglrGrid.TextMatrix(Jsqte, Sydz("003", GridStr(), Szzls)) = Trim(.Fields("Model") & "")                    '存货规格
            WglrGrid.TextMatrix(Jsqte, Sydz("004", GridStr(), Szzls)) = Trim(.Fields("PrimaryUnitName") & "")          '计量单位
            WglrGrid.TextMatrix(Jsqte, Sydz("005", GridStr(), Szzls)) = Trim(.Fields("AdjustBillName") & "")           '被调整单据名称
            WglrGrid.TextMatrix(Jsqte, Sydz("006", GridStr(), Szzls)) = Trim(.Fields("AdjustBillNum") & "")            '被调整单据号
            WglrGrid.TextMatrix(Jsqte, 1) = Trim(.Fields("AdjustBillcode") & "")                                       '被调整单据编码
            WglrGrid.TextMatrix(Jsqte, 2) = Trim(.Fields("AdjustMainId") & "")                                        '被调整单据主表ID
            WglrGrid.TextMatrix(Jsqte, 3) = Trim(.Fields("AdjustSubId") & "")                                        '被调整单据子表ID
            
            If .Fields("EMoney") <> 0 Then
                WglrGrid.TextMatrix(Jsqte, Sydz("007", GridStr(), Szzls)) = .Fields("EMoney")                          '金额
            Else
                WglrGrid.TextMatrix(Jsqte, Sydz("007", GridStr(), Szzls)) = ""
            End If
            '<<]
                   
            WglrGrid.RowHeight(Jsqte) = Sjhgd
            .MoveNext
            Jsqte = Jsqte + 1
        Loop
    End With
       
            
    '调整网格(Fixed)
    Call Sub_AdjustGrid
      
    '计算合计数据(Fixed)
    For Jsqte = Qslz To WglrGrid.Cols - 1
        Call Sjhj(Jsqte)
    Next Jsqte
    
    '将网格刷新解禁(Fixed)
    WglrGrid.Redraw = True
    
End Sub

Private Sub Tlb_Action_ButtonClick(ByVal Button As MSComctlLib.Button)             '用户点击工具条
     
    '屏蔽文本框,下拉组合框有效性判断
    Valilock = True
     
    '屏蔽网格失去焦点产生的有效性判断
    Changelock = True
         
    Select Case Button.Key
        Case "yl"                                            '预 览
            If Fun_Drfrmyxxpd Then
                BillGridPrint WglrGrid, LrText, GridStr(), Szzls, GridCode, TextGroupCode, XtReportCode, False
            End If
        Case "dy"                                            '打 印
            If Fun_Drfrmyxxpd Then
                Dim yhAnswer As Integer      '打印提示
                
                '用户确认是否打印单据
                Tsxx = "请确认是否打印当前单据?"
                yhAnswer = Xtxxts(Tsxx, 2, 2)
                If yhAnswer = 2 Then
                    Exit Sub
                End If
                BillGridPrint WglrGrid, LrText, GridStr(), Szzls, GridCode, TextGroupCode, XtReportCode, True
            End If
        Case "xz"                                            '新 增
            Call Sub_AddBill
        Case "zh"                                            '增 行
            Call zjlrfl
        Case "sh"                                            '删 行
            Call Scdqfl
        Case "bc"                                            '保 存
            If Fun_Drfrmyxxpd Then
                Call Sub_SaveBill
            End If
        Case "fq"                                            '放 弃
            Call Sub_AbandonBill
        Case "first"                                         '首 张
            Call Sub_First
        Case "prev"                                          '上 张
            Call Sub_Prev
        Case "next"                                          '下 张
            Call Sub_next
        Case "last"                                          '末 张
            Call Sub_Last
        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
    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("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_LrtextStatus(False)
            Case "20"   '新增单据(（录入）新增一张单据 、（列表）新增一张单据)
                '工具条
                .Buttons("dy").Enabled = False      '打印
                .Buttons("yl").Enabled = False      '预览
                .Buttons("xz").Enabled = False      '新增
                .Buttons("zh").Enabled = True       '增行
                .Buttons("sh").Enabled = True       '删行
                .Buttons("bc").Enabled = True       '保存
                .Buttons("fq").Enabled = True       '放弃
                .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("zh").Enabled = True       '增行
                .Buttons("sh").Enabled = True       '删行
                .Buttons("bc").Enabled = True       '保存
                .Buttons("fq").Enabled = True       '放弃
                .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)
                            
        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
    
    LrText(0).Enabled = False
    If Lab_OperStatus = "3" Then
        LrText(3).Enabled = False
    End If
    
    '制单人、记帐人设置为false
    LrText(8).Enabled = False
    LrText(9).Enabled = False

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 "001"                   '存货编码
            
                If Not Trim(Str_JudgeText) = "" Then
                    '1.放置字段有效性判断
                    SqlStr = "SELECT MNumber,MName,Model,PrimaryUnitName,PlanPrice,InvSortCode From Gy_Material Where MNumber='" & Str_JudgeText & "' Or MName='" & Str_JudgeText & "'"
                    Set Rectemp = Cw_DataEnvi.DataConnect.Execute(SqlStr)
                    If Rectemp.EOF Then
                        Tsxx = "此存货编码不存在!"
                        GoTo Lrcwcl
                    End If
                    '2.放置字段事后处理程序
                    .TextMatrix(Dqpdwgh, 4) = Trim(Rectemp.Fields("InvSortCode") & "")                              '显示存货分类
                    .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"))   '主计量单位
                  
                Else
                    '3.清空相关字段
                    .TextMatrix(Dqpdwgh, 4) = ""                                                                     '存货分类
                    .TextMatrix(Dqpdwgh, Sydz("002", GridStr(), Szzls)) = ""                                         '存货名称
                    .TextMatrix(Dqpdwgh, Sydz("003", GridStr(), Szzls)) = ""                                         '存货规格型号
                    .TextMatrix(Dqpdwgh, Sydz("004", GridStr(), Szzls)) = ""                                         '主计量单位
                End If
                
            Case "005"          '被调整单据编码
                If Not Trim(Str_JudgeText) = "" Then
                    '1.放置字段有效性判断
                    SqlStr = "SELECT billcode,billname From Gy_billnumber Where billcode='" & Str_JudgeText & "' Or billname='" & Str_JudgeText & "'"
                    Set Rectemp = Cw_DataEnvi.DataConnect.Execute(SqlStr)
                    If Rectemp.EOF Then
                        Tsxx = "此单据编码或单据名称不存在!"
                        GoTo Lrcwcl
                    Else
                        .TextMatrix(Dqpdwgh, 1) = Trim(Rectemp.Fields("billcode"))
                        .TextMatrix(Dqpdwgh, Sydz("005", GridStr(), Szzls)) = Trim(Rectemp.Fields("billname"))
                    End If
                End If

        End Select
        
        '字段录入正确后为零字段清空(Fixed)
        Call Qkwlzd(Dqpdwgh, Dqpdwgl)
     
        '字段录入正确后进行数据合计(Fixed)
        For Coljsq = Qslz To .Cols - 1
            Call Sjhj(Coljsq)
        Next Coljsq
     
        '字段有效性判断通过,将字段有效性判断加锁直至再次改变(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