VB开发的ERP系统

        Call xswbk
      
        '函数返回False
        sjzdyxxpd = False
        Exit Function
    End With
    
End Function

Private Function Sjhzyxxpd(ByVal Yxxpdh As Long) As Boolean                  '录入数据行有效性判断,同时进行行处理
 
    Dim Lrywlz As Long                     '录入错误列值(Fixed)
    Dim RecTemp As New ADODB.Recordset     '临时使用动态集
    Dim Sqlstr As String                   '临时查询字符串
 
    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
  
        '行没有发生变化则不进行有效性判断
        If Hyxxpdlock Then
            Sjhzyxxpd = True
            Exit Function
        End If

        '以下为自定义部分[

        '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.放置行处理程序(当数据行通过有效性判断)
       
        On Error GoTo Swcwcl

        Cw_DataEnvi.DataConnect.BeginTrans
         
        With RecTemp

            '判断此行记录ID是否为零,如不为零则修改记录;否则为新增记录,然后将新增后记录ID回写网格
            If Val(Trim(WglrGrid.TextMatrix(Yxxpdh, 1))) <> 0 Then
                If .State = 1 Then .Close
                .Open "SELECT Kh_Object.* From Kh_Object WHERE ObjectID = " & Val(WglrGrid.TextMatrix(Yxxpdh, 1)), Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic

                If Not .EOF Then
                    .Fields("EmpID") = Trim(WglrGrid.TextMatrix(Yxxpdh, Sydz("002", GridStr(), Szzls)))     ' 被考核对象
                    .Update
                End If
                 
            Else
               
                If .State = 1 Then .Close
                .Open "SELECT Kh_Object.* From Kh_Object WHERE 1=2", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
                 
                .AddNew
                .Fields("TitleCode") = str_TitleCode                                                         '考核类别
                .Fields("EmpID") = Trim(WglrGrid.TextMatrix(Yxxpdh, Sydz("002", GridStr(), Szzls)))          ' 被考核对象
                .Update
                    
                WglrGrid.TextMatrix(Yxxpdh, 1) = .Fields("ObjectID")                                         '记录唯一标识
                    
            End If
                 
        End With

        Cw_DataEnvi.DataConnect.CommitTrans
         
    End With

    '以上为自定义部分]

    Sjhzyxxpd = True
    Hyxxpdlock = True
    Exit Function

Swcwcl:

    Cw_DataEnvi.DataConnect.RollbackTrans
    Tsxx = "存盘过程中出现未知错误,程序自动恢复保存前状态!"
    Call Xtxxts(Tsxx, 0, 1)
    Exit Function

Lrcwcl:      '录入错误处理

    With WglrGrid
        Call Xtxxts(Tsxx, 0, 1)
        Changelock = True
        .Select Yxxpdh, Lrywlz
        Changelock = False
        Call xswbk

        Sjhzyxxpd = False
        Exit Function
    End With
    
End Function

Private Sub zjfl()
    Set frm = New Query_Frm
    Dim coll As New Collection
    Dim RecTemp As New Recordset
    Dim RecSave  As New Recordset        '临时记录集
    Dim bl_exist As Boolean         '增加人员是否存在
    Dim Jsqte As Integer            '临时计数器
    
    
    With frm
        Set .collTableName = coll
        .QueryTableSql = " TableName='Rs_BasicInfo' "
        .Show 1
        If .bChecked = False Then
            Exit Sub
        End If
        If Not (Len(Trim(frm.sSqlWhere)) > 0) Then
             frm.sSqlWhere = "1=1"
        End If
        Me.sSqlWhere = "select Empid,EmpNo,EmpName from Rs_BasicInfo where " & frm.sSqlWhere & "order by EmpNo"
    End With
    
    '禁止网格刷新动作,为加快网格显示速度(Fixed)
    WglrGrid.Redraw = False
    
    Set RecTemp = Cw_DataEnvi.DataConnect.Execute(sSqlWhere)
      
    With WglrGrid
        Do While Not RecTemp.EOF
            bl_exist = False
            For Jsqte = .FixedRows To .Rows - 1
                If .TextMatrix(Jsqte, Sydz("002", GridStr(), Szzls)) = Trim(RecTemp.Fields("EmpID") & "") Then
                    bl_exist = True
                End If
            Next Jsqte
            If bl_exist = False Then
                .AddItem ""
                .RowHeight(.Rows - 2) = Sjhgd
                .TextMatrix(.Rows - 2, 0) = "*"
                .TextMatrix(.Rows - 2, Sydz("002", GridStr(), Szzls)) = Trim(RecTemp.Fields("EmpID") & "")      '对象ID号
                .TextMatrix(.Rows - 2, Sydz("003", GridStr(), Szzls)) = Trim(RecTemp.Fields("EmpNo") & "")      '对象编号
                .TextMatrix(.Rows - 2, Sydz("004", GridStr(), Szzls)) = Trim(RecTemp.Fields("EmpName") & "")    '对象名称
        
                On Error GoTo Swcwcl
                
                Cw_DataEnvi.DataConnect.BeginTrans
                
                RecSave.Open "SELECT Kh_Object.* From Kh_Object WHERE 1=2", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
                 
                RecSave.AddNew
                RecSave.Fields("TitleCode") = str_TitleCode                                                      '考核类别
                RecSave.Fields("EmpID") = Trim(WglrGrid.TextMatrix(.Rows - 2, Sydz("002", GridStr(), Szzls)))    '被考核对象
                RecSave.Update
                    
                WglrGrid.TextMatrix(.Rows - 2, 1) = RecSave.Fields("ObjectID")                                  '记录唯一标识
                RecSave.Close
                                        
                Cw_DataEnvi.DataConnect.CommitTrans
                
                
            End If
            RecTemp.MoveNext
        Loop
    End With
    
    '禁止网格刷新动作,为加快网格显示速度(Fixed)
    WglrGrid.Redraw = True
    
    Exit Sub
    
Swcwcl:

    Cw_DataEnvi.DataConnect.RollbackTrans
    WglrGrid.Redraw = True
    Tsxx = "最后一条记录存盘过程中出现未知错误!"
    Call Xtxxts(Tsxx, 0, 1)
    Exit Sub
    
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
        Else
            '判断是否有辅助行和录入行,如没有则加行
            Do While .TextMatrix(.Rows - 1 - Fzxwghs, 0) = "*"
                .AddItem ""
                .RowHeight(.Rows - 1) = Sjhgd
            Loop
        End If
    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 >= .FixedRows Then
            '[>>
                '此处可以填写显示与此网格行相关信息
            '<<]
        End If
   End With
   
End Sub

Private Sub WglrGrid_GotFocus()                                     '网格得到焦点

    '网格得到焦点,如果当前选择行为非数据行
    '则调整当前焦点至有效数据行

    With WglrGrid
        If .Row < .FixedRows And .Rows > .FixedRows Then
            Changelock = True
            .Select .FixedRows, .Col
            Changelock = False
        End If
        If .Col < Qslz Then
            Changelock = True
            .Select .Row, Qslz
            Changelock = False
        End If
    End With

End Sub

Private Sub WglrGrid_LostFocus()                                    '录入网格失去焦点

    '用以屏蔽调用其它窗体时发生网格失去焦点事件
    If Changelock Then
        Exit Sub
    End If

    '引发网格RowcolChange事件
    With WglrGrid
        If Not (Ydtext.Visible Or YdCombo.Visible) Then
            .Select 0, 0
        End If
    End With

End Sub

Private Sub WglrGrid_AfterScroll(ByVal OldTopRow As Long, ByVal OldLeftCol As Long, ByVal NewTopRow As Long, ByVal NewLeftCol As Long)                                       '限制用户在录入过程中滚动鼠标

    If Gdtlock Then
        Exit Sub
    End If
 
    With WglrGrid