VB开发的ERP系统

        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
        
        '函数返回False
        sjzdyxxpd = False
        Exit Function
    End With
    
End Function

Private Sub Sub_JoinCount(Lng_CountRow As Long, Lng_CountCol As Long)       '当网格列值发生改变时,处理网格列之间的关联计算(可选)
    
    '过程参数:Lng_CountRow,Lng_CountCol 网格改变内容所处行列值
    
    With WglrGrid
        Select Case GridStr(Lng_CountCol, 1)         '判断网格列对应逻辑编号
            '[>>以下为自定义部分
        
            '<<以上为自定义部分]
        End Select
    End With
    
End Sub

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
        Else
            If pdhwk(Yxxpdh) And Yxxpdh + 1 <= .Rows - 1 Then
                '当要判断行处于网格末行时才允许删行,否则要进行有效性判断
                If .TextMatrix(Yxxpdh + 1, 0) <> "*" Then
                    Changelock = True
                    .RemoveItem Yxxpdh
                    If .Rows < Pmbcsjhs + .FixedRows + Fzxwghs + 1 Then
                        .AddItem ""
                        .RowHeight(.Rows - 1) = Sjhgd
                    End If
                    Changelock = False
                    Sjhzyxxpd = True
                    Exit Function
                End If
            End If
        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.放置行处理程序(当数据行通过有效性判断)
            For jsqte = Qslz To .Cols - 1
               If (GridInt(jsqte, 5) = 1 And Len(Trim(.TextMatrix(Yxxpdh, jsqte))) = 0) Or (GridInt(jsqte, 5) = 2 And Val(Trim(.TextMatrix(Yxxpdh, jsqte))) = 0) Then
                  Tsxx = GridStr(jsqte, 2)
                  Lrywlz = jsqte
                  GoTo Lrcwcl
                  Exit For
               End If
           Next jsqte
       
    Dim Sqlstr As String

    Dim str_TempSql As String
    Dim arrVar_TableCon()
    Dim arrVar_TableCon1()
    Dim arr_Var_TableCon2()
    Dim rs_Tmp As New ADODB.Recordset
    Dim Findrec As New ADODB.Recordset
    
    Dim str_VehicleNum As String
    Dim str_BeginTime As String
    Dim str_EndTime As String
    Dim str_VoucherId As String
    
    Dqpdwgh = Yxxpdh
On Error GoTo Lrcwcl

    
    
    Lrywlz = Sydz("005", GridStr(), szzls)
    str_VehicleNum = Trim(.TextMatrix(Dqpdwgh, Sydz("001", GridStr(), szzls)))
    str_BeginTime = Trim(.TextMatrix(Dqpdwgh, Sydz("004", GridStr(), szzls)))
    str_EndTime = Trim(.TextMatrix(Dqpdwgh, Sydz("005", GridStr(), szzls)))
    str_VoucherId = Trim(.TextMatrix(Dqpdwgh, 2))
    
    If str_BeginTime >= str_EndTime And str_EndTime <> "" Then
        Tsxx = "实际结束时间应大于实际开始时间！"
        Lrywlz = Sydz("005", GridStr(), szzls)
        GoTo Lrcwcl
        Exit Function
    End If
    
    If Lab_OperStatus = 2 Then '增加
        str_tmp = "select * from tr_nowaccount where vehiclenum='" & str_VehicleNum & "'and limitmark=0 order by begintime      "
        Set rs_Tmp = Nothing
        Set rs_Tmp = Cw_DataEnvi.DataConnect.Execute(str_tmp)
        If Not rs_Tmp.RecordCount = 0 Then
            ReDim arrVar_TableCon(rs_Tmp.RecordCount - 1, 2)
        End If
        k = 0
        Do While Not rs_Tmp.EOF()
            arrVar_TableCon(k, 0) = Trim(rs_Tmp.Fields("nowstatus"))
            arrVar_TableCon(k, 1) = Format(Trim(rs_Tmp.Fields("begintime")), "yyyy-mm-dd hh:mm")
            arrVar_TableCon(k, 2) = Format(Trim(rs_Tmp.Fields("endtime")), "yyyy-mm-dd hh:mm")
            rs_Tmp.MoveNext
            k = k + 1
        Loop
        If Not rs_Tmp.RecordCount = 0 Then
            If str_BeginTime < arrVar_TableCon(UBound(arrVar_TableCon, 1), 2) Then
                If Trim(str_EndTime) = "" Then
                    Tsxx = "实际结束时间不能为空"
                    GoTo Lrcwcl
                    Exit Function
                End If
            End If

            i = UBound(arrVar_TableCon, 1)
            If str_BeginTime >= arrVar_TableCon(i, 1) Then
                Tsxx = "此车号正处于" & arrVar_TableCon(i, 0) & "状态，不能进行其他处理！"
                GoTo Lrcwcl
                Exit Function
            End If
            If str_EndTime <> "" Then
                If str_EndTime >= arrVar_TableCon(i, 1) Then
                    Tsxx = "此车号正处于" & arrVar_TableCon(i, 0) & "状态，不能进行其他处理！"
                    GoTo Lrcwcl
                    Exit Function
                End If
            End If

        End If
        
        str_tmp = "select * from tr_nowaccount where vehiclenum='" & str_VehicleNum & "'and limitmark=1 order by begintime      "
        Set rs_Tmp = Nothing
        Set rs_Tmp = Cw_DataEnvi.DataConnect.Execute(str_tmp)
        If Not rs_Tmp.RecordCount = 0 Then
            ReDim arrVar_TableCon2(rs_Tmp.RecordCount - 1, 2)
        End If
        k = 0
        Do While Not rs_Tmp.EOF()
            arrVar_TableCon2(k, 0) = Trim(rs_Tmp.Fields("nowstatus"))
            arrVar_TableCon2(k, 1) = Format(Trim(rs_Tmp.Fields("begintime")), "yyyy-mm-dd hh:mm")
            arrVar_TableCon2(k, 2) = Format(Trim(rs_Tmp.Fields("endtime")), "yyyy-mm-dd hh:mm")
            
            rs_Tmp.MoveNext
            k = k + 1
        Loop
        If Not rs_Tmp.RecordCount = 0 Then
            If str_BeginTime < arrVar_TableCon2(UBound(arrVar_TableCon2, 1), 2) Then
                If Trim(str_EndTime) = "" Then
                    Tsxx = "实际结束时间不能为空"
                    GoTo Lrcwcl
                    Exit Function
                End If
            End If
            For i = LBound(arrVar_TableCon2, 1) To UBound(arrVar_TableCon2, 1)
                If str_BeginTime >= arrVar_TableCon2(i, 1) And str_BeginTime <= arrVar_TableCon2(i, 2) Then
                    Tsxx = "此车号在" & arrVar_TableCon2(i, 1) & "至" & arrVar_TableCon2(i, 2) & ",处于" & arrVar_TableCon2(i, 0) & "状态，请重新输入时间！"
                    GoTo Lrcwcl
                    Exit Function
                End If
                If str_EndTime >= arrVar_TableCon2(i, 1) And str_EndTime <= arrVar_TableCon2(i, 2) Then
                    Tsxx = "此车号在" & arrVar_TableCon2(i, 1) & "至" & arrVar_TableCon2(i, 2) & ",处于" & arrVar_TableCon2(i, 0) & "状态，请重新输入时间！"
                    GoTo Lrcwcl
                    Exit Function
                End If
                If str_BeginTime <= arrVar_TableCon2(i, 1) And str_EndTime >= arrVar_TableCon2(i, 2) Then
                        Tsxx = "此车号在" & arrVar_TableCon2(i, 1) & "至" & arrVar_TableCon2(i, 2) & ",处于" & arrVar_TableCon2(i, 0) & "状态，请重新输入时间！"
                        GoTo Lrcwcl
                        Exit Function
                End If
            Next i
        End If
    Else  '修改
        str_tmp = "select * from tr_nowaccount where vehiclenum='" & str_VehicleNum & "'and limitmark=0 order by begintime      "
        Set rs_Tmp = Nothing
        Set rs_Tmp = Cw_DataEnvi.DataConnect.Execute(str_tmp)
        If Not rs_Tmp.RecordCount = 0 Then
          ReDim arrVar_TableCon(rs_Tmp.RecordCount - 1, 3)
        End If
        k = 0
        Do While Not rs_Tmp.EOF()
          arrVar_TableCon(k, 0) = Trim(rs_Tmp.Fields("nowstatus"))
          arrVar_TableCon(k, 1) = Format(Trim(rs_Tmp.Fields("begintime")), "yyyy-mm-dd hh:mm")
          arrVar_TableCon(k, 2) = Format(Trim(rs_Tmp.Fields("endtime")), "yyyy-mm-dd hh:mm")
          arrVar_TableCon(k, 3) = rs_Tmp.Fields("VoucherId")
          rs_Tmp.MoveNext
          k = k + 1
        Loop
        If Not rs_Tmp.RecordCount = 0 Then

            If str_BeginTime < arrVar_TableCon(UBound(arrVar_TableCon, 1), 2) And Trim(arrVar_TableCon(i, 3)) <> str_VoucherId Then
                If Trim(str_EndTime) = "" Then
                    Tsxx = "实际结束时间不能为空"
                    GoTo Lrcwcl
                    Exit Function
                End If
            End If

            i = UBound(arrVar_TableCon, 1)
            If str_BeginTime >= arrVar_TableCon(i, 1) And Trim(arrVar_TableCon(i, 3)) <> str_VoucherId Then
                Tsxx = "此车号正处于" & arrVar_TableCon(i, 0) & "状态，请重新输入时间！"
                GoTo Lrcwcl
                Exit Function
            End If
            If str_EndTime <> "" Then
                If str_EndTime >= arrVar_TableCon(i, 1) And Trim(arrVar_TableCon(i, 3)) <> str_VoucherId Then
                    Tsxx = "此车号正处于" & arrVar_TableCon(i, 0) & "状态，请重新输入时间！"
                    GoTo Lrcwcl
                    Exit Function
                End If
            End If

        End If
        
        str_tmp = "select * from tr_nowaccount where vehiclenum='" & str_VehicleNum & "'and limitmark=1 order by begintime      "
        Set rs_Tmp = Nothing
        Set rs_Tmp = Cw_DataEnvi.DataConnect.Execute(str_tmp)
        If Not rs_Tmp.RecordCount = 0 Then
          ReDim arrVar_TableCon2(rs_Tmp.RecordCount - 1, 3)
        End If
        k = 0
        Do While Not rs_Tmp.EOF()
          arrVar_TableCon2(k, 0) = Trim(rs_Tmp.Fields("nowstatus"))
          arrVar_TableCon2(k, 1) = Format(Trim(rs_Tmp.Fields("begintime")), "yyyy-mm-dd hh:mm")
          arrVar_TableCon2(k, 2) = Format(Trim(rs_Tmp.Fields("endtime")), "yyyy-mm-dd hh:mm")
          arrVar_TableCon2(k, 3) = rs_Tmp.Fields("VoucherId")
          rs_Tmp.MoveNext
          k = k + 1
        Loop

        If Not rs_Tmp.RecordCount = 0 Then
            If str_BeginTime < arrVar_TableCon2(UBound(arrVar_TableCon2, 1), 2) Then
                If Trim(str_EndTime) = "" Then
                    Tsxx = "实际结束时间不能为空"
                    GoTo Lrcwcl
                    Exit Function
                End If
            End If
            For i = LBound(arrVar_TableCon2, 1) To UBound(arrVar_TableCon2, 1)
                If str_BeginTime >= arrVar_TableCon2(i, 1) And str_BeginTime <= arrVar_TableCon2(i, 2) And Trim(arrVar_TableCon2(i, 3)) <> str_VoucherId Then
                    Tsxx = "此车号在" & arrVar_TableCon2(i, 1) & "至" & arrVar_TableCon2(i, 2) & ",处于" & arrVar_TableCon2(i, 0) & "状态，请重新输入时间！"
                    GoTo Lrcwcl
                    Exit Function
                End If
                If str_EndTime >= arrVar_TableCon2(i, 1) And str_EndTime <= arrVar_TableCon2(i, 2) And Trim(arrVar_TableCon2(i, 3)) <> str_VoucherId Then
                    Tsxx = "此车号在" & arrVar_TableCon2(i, 1) & "至" & arrVar_TableCon2(i, 2) & ",