VB开发的ERP系统

            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_EnvironmentReport 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("Reporter") = Xtczy                                                                      '制单人
                .Fields("ItemId") = Trim(WglrGrid.TextMatrix(Rowjsq, 1))                                         '取样点
                .Fields("Result") = Trim(WglrGrid.TextMatrix(Rowjsq, Sydz("003", GridStr(), Szzls)))             '检验结果
                .Fields("Remark") = Trim(WglrGrid.TextMatrix(Rowjsq, Sydz("004", GridStr(), Szzls)))             '备注
                .Update
            Next Rowjsq
            Lab_BillId.Caption = .Fields("ReportDate")
        End With
    Else
        '修改单据
        
        '1.删除原单据子表中所有内容
        Cw_DataEnvi.DataConnect.Execute (" Delete From Qc_EnvironmentReport  Where ReportDate='" & Trim(Lab_BillId.Caption) & "'")

        
        '打开单据主表动态集
        If Rec_VouchMain.State = 1 Then Rec_VouchMain.Close
        Rec_VouchMain.Open "Select * From Qc_EnvironmentReport 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("Reporter") = Xtczy                                                                      '制单人
                .Fields("ItemId") = Trim(WglrGrid.TextMatrix(Rowjsq, 1))                                         '取样点
                .Fields("Result") = Trim(WglrGrid.TextMatrix(Rowjsq, Sydz("003", GridStr(), Szzls)))             '检验结果
                .Fields("Remark") = Trim(WglrGrid.TextMatrix(Rowjsq, Sydz("004", GridStr(), Szzls)))             '备注
                .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,stand From Qc_WorkEnvirItem Where Style='3' 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", GridStr(), Szzls)) = Trim(.Fields("ItemName") & "")
                WglrGrid.TextMatrix(Jsqte, Sydz("002", GridStr(), Szzls)) = Trim(.Fields("stand") & "")
                .MoveNext
                Jsqte = Jsqte + 1
            Loop
            .MoveFirst
        End With
    
    End If
End Sub
'[>>===================以上为根据实际业务需要自定义过程区域=============================<<]

'===================以 下 程 序 为 通 用 部 分 ,一 般 不 需 更 改(程序动作部分)======================='
Private Sub Sub_AdjustGrid()
    
    '调 整 网 格
    With WglrGrid
        '加 1 保持一行录入行
        If .Rows < Pmbcsjhs + .FixedRows + Fzxwghs + 1 Then
            .Rows = Pmbcsjhs + .FixedRows + Fzxwghs + 1
            For Jsqte = .FixedRows To .Rows - 1
                .RowHeight(Jsqte) = Sjhgd
            Next Jsqte
        End If
        
        '判断是否有辅助行和录入行,如没有则加行
        Do While .TextMatrix(.Rows - 1 - Fzxwghs, 0) = "*"
            .AddItem ""
            .RowHeight(.Rows - 1) = Sjhgd
        Loop
    
    End With
    
End Sub

Private Sub Lrzdbz()                                                      '录入字段帮助
    
    If Not Ydcommand.Visible Then
        Exit Sub
    End If
    
    With WglrGrid
        Valilock = True
        
        '处理通用部分
        Changelock = True        '调入另外窗体必须加锁
        Call Drbmhelp(GridInt(.Col, 6), GridStr(.Col, 3), Trim(Ydtext.Text))
        Changelock = False
        
        If Len(Xtfhcs) <> 0 Then
            If GridInt(.Col, 7) = 0 Then
                Ydtext.Text = Xtfhcs
            Else
                Ydtext.Text = Xtfhcsfz
            End If
        End If
        
        Valilock = False
        If Ydtext.Visible Then
            Ydtext.SetFocus
        End If
    End With
    
End Sub



Private Sub Form_Resize()                                                '窗体大小发生变化时,重新显示文本框
    Call Cxxswbk
End Sub

Private Function Fun_Drfrmyxxpd() As Boolean                             '调入其它窗体或功能产生的有效性判断(包括数据回写)
    Fun_Drfrmyxxpd = True
    With WglrGrid
        
        '如果当前网格处于编辑状态,则先进行数据回写再进行有效性判断
        If Ydtext.Visible Or YdCombo.Visible Then
            Call Lrsjhx
            If Not sjzdyxxpd(Dqlrwgh, Dqlrwgl) Then
                Fun_Drfrmyxxpd = False
                Exit Function
            End If
        End If
        
        '进行行有效性判断
        If Not Sjhzyxxpd(.Row) Then
            Fun_Drfrmyxxpd = False
            Exit Function
        End If
        
    End With
    
End Function



Private Sub WglrGrid_EnterCell()                                                 '显示当前数据行相关信息
    
    With WglrGrid
        If .Row >= .FixedR