VB开发的ERP系统

            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 From Gy_Material Where Mnumber='" & Str_JudgeText & "'"
                Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
                If RecTemp.EOF Then
                    Tsxx = "此货物编码不存在!"
                    GoTo Lrcwcl
                End If
                '2.放置字段事后处理程序
                .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") & "")     '显示存货规格型号
            Else
                '3.清空相关字段
                .TextMatrix(Dqpdwgh, Sydz("002", GridStr(), szzls)) = ""                                             '存货名称
                .TextMatrix(Dqpdwgh, Sydz("003", GridStr(), szzls)) = ""                                             '存货规格型号
            End If
        Case "006"                   '车号
            If Not Trim(Str_JudgeText) = "" Then
                '1.放置字段有效性判断
                Sqlstr = "SELECT vehiclenum,typename From tr_v_vehiclefile Where vehiclenum='" & Str_JudgeText & "'"
                Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
                If RecTemp.EOF Then
                    Tsxx = "此车号不存在!"
                    GoTo Lrcwcl
                End If
                '2.放置字段事后处理程序
                .TextMatrix(Dqpdwgh, Sydz("007", GridStr(), szzls)) = Trim(RecTemp.Fields("typename") & "")      '车辆类型
            Else
                '3.清空相关字段
                .TextMatrix(Dqpdwgh, Sydz("007", GridStr(), szzls)) = ""
            End If
            If Trim(Me.WglrGrid.TextMatrix(Dqpdwgh, Sydz("006", GridStr(), szzls))) <> "" Then
                For jsqtmp = 0 To Dqpdwgh - 1
                    If Trim(Me.WglrGrid.TextMatrix(jsqtmp, Sydz("006", GridStr(), szzls))) = Trim(Me.WglrGrid.TextMatrix(Dqpdwgh, Sydz("006", GridStr(), szzls))) Then
                        Tsxx = "车号不能重复!"
                        GoTo Lrcwcl
                    End If
                Next
            End If
        Case "008"     '单位
        
            If Not Trim(Str_JudgeText) = "" Then
                '1.放置字段有效性判断
                If OptXs.Value Then
                    Sqlstr = "select custcode,custname,address,station from Tr_TrainUnit where stopflag=0 and custname='" & Str_JudgeText & "'"
                    Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
                    If RecTemp.EOF Then
                        Tsxx = "此单位不存在!"
                        GoTo Lrcwcl
                    End If
                    '2.放置字段事后处理程序
                    .TextMatrix(Dqpdwgh, 3) = Trim(RecTemp.Fields("custcode") & "")
                    .TextMatrix(Dqpdwgh, Sydz("009", GridStr(), szzls)) = Trim(RecTemp.Fields("station") & "")      '到站
                Else
                    Sqlstr = "select SourceCode,SourceName from Tr_Source where StopFlag=0 and TrainFlag=1 and SourceName='" & Str_JudgeText & "'"
                    Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
                    If RecTemp.EOF Then
                        Tsxx = "此单位不存在!"
                        GoTo Lrcwcl
                    End If
                    .TextMatrix(Dqpdwgh, 3) = Trim(RecTemp.Fields("sourcecode") & "")
                End If
            Else
                '3.清空相关字段
                .TextMatrix(Dqpdwgh, Sydz("009", GridStr(), szzls)) = ""
            End If
        Case "010"
            str_value = Trim(Me.WglrGrid.TextMatrix(Dqpdwgh, Sydz(GridStr(Dqpdwgl, 1), GridStr(), szzls)))
            If str_value <> "" Then
                If IsDate(str_value) Then
                    If Val(str_value) <> Val(Year(Xtrq)) Then
                        Tsxx = "年度与当前会计年度不符，请重新输入"
                        GoTo Lrcwcl
                    End If
                    .TextMatrix(Dqpdwgh, Sydz("010", GridStr(), szzls)) = Format(str_value, "yyyy-mm-dd hh:mm")
                Else
                    Tsxx = "非法公历日期!(格式:" + Format(Date, "yyyy-mm-dd hh:mm") + ")"
                    GoTo Lrcwcl
                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
        
        '函数返回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)         '判断网格列对应逻辑编号
            
            '[>>以下为自定义部分
        Case "004"    '单重改变
            '计算公式:单重*数量=总重
            If Val(.TextMatrix(Lng_CountRow, Sydz("004", GridStr(), szzls))) * Val(.TextMatrix(Lng_CountRow, Sydz("006", GridStr(), szzls))) <> 0 Then
                .TextMatrix(Lng_CountRow, Sydz("007", GridStr(), szzls)) = Format(Val(.TextMatrix(Lng_CountRow, Sydz("004", GridStr(), szzls))) * Val(.TextMatrix(Lng_CountRow, Sydz("006", GridStr(), szzls))), "###0." + String(Xtslxsws, "0"))
            Else
                .TextMatrix(Lng_CountRow, Sydz("007", GridStr(), szzls)) = ""
            End If
        Case "005"    '单价改变
            '计算公式:单价*数量=金额
            If Val(.TextMatrix(Lng_CountRow, Sydz("005", GridStr(), szzls))) * Val(.TextMatrix(Lng_CountRow, Sydz("006", GridStr(), szzls))) <> 0 Then
                .TextMatrix(Lng_CountRow, Sydz("008", GridStr(), szzls)) = Format(Val(.TextMatrix(Lng_CountRow, Sydz("005", GridStr(), szzls))) * Val(.TextMatrix(Lng_CountRow, Sydz("006", GridStr(), szzls))), "##0." + String(Xtjexsws, "0"))
            Else
                .TextMatrix(Lng_CountRow, Sydz("008", GridStr(), szzls)) = ""
            End If
        Case "006"    '数量改变
            '计算公式:单重*数量=总重
            If Val(.TextMatrix(Lng_CountRow, Sydz("004", GridStr(), szzls))) * Val(.TextMatrix(Lng_CountRow, Sydz("006", GridStr(), szzls))) <> 0 Then
                .TextMatrix(Lng_CountRow, Sydz("007", GridStr(), szzls)) = Format(Val(.TextMatrix(Lng_CountRow, Sydz("004", GridStr(), szzls))) * Val(.TextMatrix(Lng_CountRow, Sydz("006", GridStr(), szzls))), "###0." + String(Xtslxsws, "0"))
            Else
                .TextMatrix(Lng_CountRow, Sydz("007", GridStr(), szzls)) = ""
            End If
            '计算公式:单价*数量=金额
            If Val(.TextMatrix(Lng_CountRow, Sydz("005", GridStr(), szzls))) * Val(.TextMatrix(Lng_CountRow, Sydz("006", GridStr(), szzls))) <> 0 Then
                .TextMatrix(Lng_CountRow, Sydz("008", GridStr(), szzls)) = Format(Val(.TextMatrix(Lng_CountRow, Sydz("005", GridStr(), szzls))) * Val(.TextMatrix(Lng_CountRow, Sydz("006", GridStr(), szzls))), "###0." + String(Xtjexsws, "0"))
            Else
                .TextMatrix(Lng_CountRow, Sydz("008", GridStr(), szzls)) = ""
            End If
        Case "008"    '金额改变
            '计算公式:金额/数量=单价
            If Val(.TextMatrix(Lng_CountRow, Sydz("006", GridStr(), szzls))) <> 0 Then
                If Val(.TextMatrix(Lng_CountRow, Sydz("008", GridStr(), szzls))) / Val(.TextMatrix(Lng_CountRow, Sydz("006", GridStr(), szzls))) <> 0 Then
                    .TextMatrix(Lng_CountRow, Sydz("005", GridStr(), szzls)) = Format(Val(.TextMatrix(Lng_CountRow, Sydz("008", GridStr(), szzls))) / Val(.TextMatrix(Lng_CountRow, Sydz("006", GridStr(), szzls))), "###0." + String(Xtdjxsws, "0"))
                End If
            End If
            '<<以上为自定义部分]
        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.放置行处理程序(当数据行通过有效性判断)
    
    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("010", GridStr(), szzls)
    str_VehicleNum = Trim(.TextMatrix(Dqpdwgh, Sydz("006", GridStr(), szzls)))
    str_BeginTime = Trim(.TextMatrix(Dqpdwgh, Sydz("010", GridStr(), szzls)))
    str_EndTime = Trim(.TextMatrix(Dqpdwgh, Sydz("010", GridStr(), szzls)))
    str_VoucherId = Trim(.TextMatrix(Dqpdwgh, 2))
    
    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 No