VB开发的ERP系统

            
            WglrGrid.Clear 1
            Changelock = True
            .Select .FixedRows, Qslz
            Changelock = False
        End With
        
        
    End If
    
    '设置操作状态为浏览
    Lab_OperStatus = "1"
    Call Sub_OperStatus("10")
    
End Sub

Private Function Sub_SaveBill() As Boolean                                   '保 存 单 据
    
    Dim RecTemp As New ADODB.Recordset                    '临时使用动态集
    Dim Rec_VouchMain As New ADODB.Recordset              '单据表动态集
    Dim Rowjsq As Long                                    '网格行计数器
    Dim Coljsq As Long                                    '网格列计数器
    Dim Jsqte As Integer                                  '临时计数器
    Dim Lng_RowCount As Long                              '有效数据行计数器
    Dim Lrywlz As Long                                    '录入有误列值
    Sub_SaveBill = False
    
    '一.============先对单据内容进行有效性判断==============='
    
    '先进行字段不能为空或不能为零有效性判断(Fixed)
    For Jsqte = 0 To Max_Text_Index
        If Textint(Jsqte, 8) = 1 Then     '字段不能为空
            If Len(Trim(LrText(Jsqte).Text)) = 0 Then
                Tsxx = Textstr(Jsqte, 7) & "不能为空!"
                Call Xtxxts(Tsxx, 0, 1)
                LrText(Jsqte).SetFocus
                Exit Function
            End If
        Else
            If Textint(Jsqte, 8) = 2 Then   '字段不能为零
                If Val(Trim(LrText(Jsqte).Text)) = 0 Then
                    Tsxx = Textstr(Jsqte, 7) & "不能为零!"
                    Call Xtxxts(Tsxx, 0, 1)
                    LrText(Jsqte).SetFocus
                    Exit Function
                End If
            End If
        End If
    Next Jsqte
    
    '对需要进行事后判断的文本框录入内容进行有效性判断 (Fixed)
    For Jsqte = 0 To Max_Text_Index
        If Textint(Jsqte, 9) = 0 Or Textint(Jsqte, 9) = 2 Then
            If Not TextYxxpd(Jsqte) Then
                Call TextShow(Jsqte)
                Exit Function
            End If
        End If
    Next Jsqte
    
    '[>>
    
    '可在此区域写入其他对单据表头内容的有效性判断.
    
    '<<]
    
    '[>>下面将对所有有效数据行进行有效性判断
    
    Lng_RowCount = 0
    
    With WglrGrid
        For Rowjsq = .FixedRows To .Rows - 1
            '带*号者为有效数据行(Fixed)
            If .TextMatrix(Rowjsq, 0) <> "*" Then
                Exit For
            Else
                Lng_RowCount = Lng_RowCount + 1
            End If
            
            '1.首先进行为空或为零判断(Fixed)
            
            For Jsqte = Qslz To .Cols - 1
                
                '字段不能为空
                If GridInt(Jsqte, 5) = 1 Then
                    If Len(Trim(.TextMatrix(Rowjsq, 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(Rowjsq, Jsqte))) = 0 Then
                        Tsxx = GridStr(Jsqte, 2)
                        Lrywlz = Jsqte
                        GoTo Lrcwcl
                        Exit For
                    End If
                End If
            Next Jsqte
            
            
            
        Next Rowjsq
        
        '单据分录行数不能为零(Fixed)
        If Lng_RowCount = 0 Then
            Tsxx = "单据分录行数不能为零!"
            Call Xtxxts(Tsxx, 0, 1)
            Exit Function
        End If
        
        '[>>
        '此处可以定义整张单据不能通过有效性检查的理由
        '<<]
    End With  '网格
    
    
    '二.=============如果以上有效性检查均顺利通过,则执行存盘动作============'
    
    '对存盘进行事务处理(Fixed)
    On Error GoTo Swcwcl
    Cw_DataEnvi.DataConnect.BeginTrans
    
    '判断单据状态以进行不同处理
    
    '1.先对单据主表进行处理
    If Trim(Lab_OperStatus) = "2" Then
        
        '新增单据
        
        
        '2.开始存盘
        
        '打开单据表动态集
        If Rec_VouchMain.State = 1 Then Rec_VouchMain.Close
        Rec_VouchMain.Open "Select * From Qc_GasReport Where 1=2", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
        
        With Rec_VouchMain
            '将网格中有效数据行写入单据表
            For Rowjsq = WglrGrid.FixedRows To WglrGrid.Rows - 1
                If WglrGrid.TextMatrix(Rowjsq, 0) <> "*" Then
                    Exit For
                End If
                .AddNew
                .Fields("ReportDate") = CDate(LrText(0).Text)                                                    '单据日期
                .Fields("Remark") = Trim(LrText(1).Text)                                                         '备注
                .Fields("Reporter") = Xtczy                                                                      '制单人
                .Fields("ItemId") = Trim(WglrGrid.TextMatrix(Rowjsq, 1))                                         '取样点
                .Fields("CL") = Trim(WglrGrid.TextMatrix(Rowjsq, Sydz("002", GridStr(), Szzls)))                  '氯气
                .Fields("HCL") = Trim(WglrGrid.TextMatrix(Rowjsq, Sydz("003", GridStr(), Szzls)))                '氯化氢
                .Fields("NH") = Trim(WglrGrid.TextMatrix(Rowjsq, Sydz("004", GridStr(), Szzls)))                 '氨气
                .Fields("SO") = Trim(WglrGrid.TextMatrix(Rowjsq, Sydz("005", GridStr(), Szzls)))                 '二氧化硫
                .Fields("HS") = Trim(WglrGrid.TextMatrix(Rowjsq, Sydz("006", GridStr(), Szzls)))                 '硫化氢
                .Fields("A1") = Trim(WglrGrid.TextMatrix(Rowjsq, Sydz("007", GridStr(), Szzls)))                 '备用1
                .Fields("A2") = Trim(WglrGrid.TextMatrix(Rowjsq, Sydz("008", GridStr(), Szzls)))                 '备用2
                .Update
            Next Rowjsq
            Lab_BillId.Caption = .Fields("ReportDate")
        End With
    Else
        '修改单据
        
        '1.删除原单据子表中所有内容
        Cw_DataEnvi.DataConnect.Execute (" Delete From Qc_GasReport  Where ReportDate='" & Trim(Lab_BillId.Caption) & "'")
        
        '打开单据主表动态集
        If Rec_VouchMain.State = 1 Then Rec_VouchMain.Close
        Rec_VouchMain.Open "Select * From Qc_GasReport Where 1=2", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
        
        With Rec_VouchMain
            '将网格中有效数据行写入单据表
            For Rowjsq = WglrGrid.FixedRows To WglrGrid.Rows - 1
                If WglrGrid.TextMatrix(Rowjsq, 0) <> "*" Then
                    Exit For
                End If
                .AddNew
                .Fields("ReportDate") = CDate(LrText(0).Text)                                                    '单据日期
                .Fields("Remark") = Trim(LrText(1).Text)                                                         '备注
                .Fields("Reporter") = Xtczy                                                                      '制单人
                .Fields("ItemId") = Trim(WglrGrid.TextMatrix(Rowjsq, 1))                                         '取样点
                .Fields("CL") = Trim(WglrGrid.TextMatrix(Rowjsq, Sydz("002", GridStr(), Szzls)))                  '氯气
                .Fields("HCL") = Trim(WglrGrid.TextMatrix(Rowjsq, Sydz("003", GridStr(), Szzls)))                '氯化氢
                .Fields("NH") = Trim(WglrGrid.TextMatrix(Rowjsq, Sydz("004", GridStr(), Szzls)))                 '氨气
                .Fields("SO") = Trim(WglrGrid.TextMatrix(Rowjsq, Sydz("005", GridStr(), Szzls)))                 '二氧化硫
                .Fields("HS") = Trim(WglrGrid.TextMatrix(Rowjsq, Sydz("006", GridStr(), Szzls)))                 '硫化氢
                .Fields("A1") = Trim(WglrGrid.TextMatrix(Rowjsq, Sydz("007", GridStr(), Szzls)))                 '备用1
                .Fields("A2") = Trim(WglrGrid.TextMatrix(Rowjsq, Sydz("008", GridStr(), Szzls)))                 '备用2
                .Update
            Next Rowjsq
            Lab_BillId.Caption = .Fields("ReportDate")
        End With
    End If
    
    
    Cw_DataEnvi.DataConnect.CommitTrans
    
    Sub_SaveBill = True
    Tsxx = "单据存盘完毕!"
    Call Xtxxts(Tsxx, 0, 4)
    
    '标识单据发生改动
    Bln_BillChange = True
    
    '设置单据改变后的状态
    Lab_OperStatus = "1"
    Call Sub_OperStatus("10")
    Rec_Query.Requery
    Rec_Query.Find "ReportDate='" & Trim(Lab_BillId.Caption) & "'"
    
    Exit Function
    
Swcwcl:       '数据存盘时出现错误
    Cw_DataEnvi.DataConnect.RollbackTrans
    With WglrGrid
        If Err.Number = -2147217887 Then
            Tsxx = "单据中第  " & Trim(Str(Rowjsq - .FixedRows + 1)) & " 条分录录入数据超出允许范围!"
            Call Xtxxts(Tsxx, 0, 1)
            Changelock = True
            .Select Rowjsq, Qslz
            WglrGrid.SetFocus
            Changelock = False
            Exit Function
        Else
            Tsxx = "存盘过程中出现未知错误,程序自动恢复保存前状态!"
            Call Xtxxts(Tsxx, 0, 1)
            Exit Function
        End If
    End With
    
Lrcwcl:        '录入错误处理(存盘前逐行有效性判断)
    With WglrGrid
        Call Xtxxts("(第 " & Trim(Str(Rowjsq - .FixedRows + 1)) & " 条单据分录)-" & Tsxx, 0, 1)
        Changelock = True
        .Select Rowjsq, Lrywlz
        WglrGrid.SetFocus
        Changelock = False
        Exit Function
    End With
    
End Function


'选择首张,上张,下张,末张
Private Sub Sub_First()             '首 张
    
    With Rec_Query
        If .RecordCount = 0 Then
            Exit Sub
        End If
        .MoveFirst
        Lab_BillId.Caption = .Fields("ReportDate")
        Call Sub_ShowBill
    End With
    
End Sub

Private Sub Sub_Prev()             '上 张
    
    With Rec_Query
        If .RecordCount = 0 Then
            Exit Sub
        End If
        If Not .BOF Then
            .MovePrevious
        End If
        If Not .BOF Then
            Lab_BillId.Caption = .Fields("ReportDate")
        Else
            .MoveNext
        End If
        Call Sub_ShowBill
    End With
    
End Sub

Private Sub Sub_Next()             '下 张
    With Rec_Query
        If .RecordCount = 0 Then
            Exit Sub
        End If
        If Not .EOF Then
            .MoveNext
        End If
        If Not .EOF Then
            Lab_BillId.Caption = .Fields("ReportDate")
        Else
            .MovePrevious
        End If
        Call Sub_ShowBill
    End With
    
End Sub

Private Sub Sub_Last()              '末 张
    
    With Rec_Query
        If .RecordCount = 0 Then
            Exit Sub
        End If
        .MoveLast
        Lab_BillId.Caption = .Fields("ReportDate")
        Call Sub_ShowBill
    End With
    
End Sub
    
'[>>===================以下为根据实际业务需要自定义过程区域=============================<<]




Private Sub Sub_FillGrid()
    Dim Rec_Temp As New ADODB.Recordset      '临时使用动态集
    Dim Jsqte As Long                        '临时使用计数器
    Sqlstr = "Select distinct ItemId,ItemName From Qc_WorkEnvirItem Where Style='2' Order By ItemId"
    Set Rec_Temp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
    If Rec_Temp.RecordCount > 0 Then                        '废气有检验项目
        With Rec_Temp
            Jsqte = WglrGrid.FixedRows
            Do While Not .EOF
                If Jsqte >= WglrGrid.Rows Then
                    WglrGrid.AddItem ""
                    WglrGrid.RowHeight(Jsqte) = Sjhgd
                End If
                WglrGrid.TextMatrix(Jsqte, 0) = "*"
                WglrGrid.TextMatrix(Jsqte, 1) = Trim(.Fields("ItemId") & "")
                WglrGrid.TextMatrix(Jsqte, Sydz("001", G