VB开发的ERP系统

            .MoveNext
            jsqte = jsqte + 1
        Loop
    End With
    
    ']以上为用户自定义部分
    
End Sub

Private Sub CxbbGrid_DblClick()                                              '用户双击网格调入相应单据
    Dim RecTemp As New ADODB.Recordset               '临时使用动态集
    Dim str_id As String
    Dim int_zgh As Integer
    
    
    '非数据行退出
    If CxbbGrid.Row < CxbbGrid.FixedRows Or CxbbGrid.TextMatrix(CxbbGrid.Row, Sydz("001", GridStr(), Szzls)) = "" Then
        Exit Sub
    End If
     
     '取最后一条
    str_id = CxbbGrid.TextMatrix(CxbbGrid.Row, Sydz("001", GridStr(), Szzls))
    For int_zgh = CxbbGrid.Row To CxbbGrid.Rows - 1
       If CxbbGrid.TextMatrix(int_zgh, Sydz("001", GridStr(), Szzls)) <> "" Then
           If CxbbGrid.TextMatrix(int_zgh, Sydz("001", GridStr(), Szzls)) <> str_id Then
               Exit For
           End If
       End If
    Next
    CxbbGrid.Row = int_zgh - 1
    
    '查询最后一条
    Sqlstr = "SELECT * From Rs_Change Where EmpID=" & Val(CxbbGrid.TextMatrix(CxbbGrid.Row, Sydz("001", GridStr(), Szzls)))
    Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
    With RecTemp
        If .EOF Then
            Tsxx = "此记录已被其他用户删除!"
            Call Xtxxts(Tsxx, 0, 1)
            Exit Sub
        Else
            '判断所查询的是否是真正的最后一条
            .MoveLast
            If .Fields("SNo") <> CxbbGrid.TextMatrix(CxbbGrid.Row, Sydz("002", GridStr(), Szzls)) Then
                Tsxx = "此职工的变动记录不是最后一条，不能操作!"
                Call Xtxxts(Tsxx, 0, 1)
                Exit Sub
            End If
            
            '判断是否是停用的记录
            If .Fields("ChangeType") = "1002" Then
                Tsxx = "此职工已经停用，不能操作!"
                Call Xtxxts(Tsxx, 0, 1)
                Exit Sub
            End If
            
            
            '调入单据处理窗体
            With Ed_EmpChgFrm
                
                '填充查询单据标识
                XT_BillID = CxbbGrid.TextMatrix(CxbbGrid.Row, Sydz("003", GridStr(), Szzls))
                str_mark = CxbbGrid.TextMatrix(CxbbGrid.Row, Sydz("002", GridStr(), Szzls))
                Xtcdcsfz = Str_QueryCondi
                
                '设置单据处理为列表查询(修改)状态
                Xtcdcs = "2"
                .Show 1
            End With
            
            If Xtfhcs = "1" Then
                Tsxx = "人员变动记录发生变化,是否刷新?"
                Yhanswer = Xtxxts(Tsxx, 2, 2)
                If Yhanswer = 1 Then
                    Xt_Wait.Show
                    Xt_Wait.Refresh
                    
                    '加快显示速度
                    CxbbGrid.Redraw = False
                    '生成查询结果
                    Call Sub_Query(1)
                    
                    CxbbGrid.Redraw = True
                    
                    Xt_Wait.Hide
                End If
            End If
        End If
    End With
    
End Sub

Private Sub Sub_AddBill()                                              '新增单据
    
    With Ed_EmpChgFrm
        
        '设置单据处理为填制单据状态
        Xtcdcs = "1"
        
        .Show 1
    End With
    
    If Xtfhcs = "1" Then
        Tsxx = "人事变动发生变化,是否刷新人事变动列表?"
        Yhanswer = Xtxxts(Tsxx, 2, 2)
        
        If Yhanswer = 1 Then
            Xt_Wait.Show
            Xt_Wait.Refresh
            
            '加快显示速度
            CxbbGrid.Redraw = False
            
            '生成查询结果
            Call Sub_Query(1)
            
            CxbbGrid.Redraw = True
            Xt_Wait.Hide
        End If
    End If
    
End Sub

Private Sub Sub_DeleteBill()                                            '删除选中当前单据
    
    Dim YAnswer As Integer
    Dim Lng_BillID As Long           '单据标识
    Dim str_id As String
    Dim int_zgh As Integer
    Dim RecTemp As New ADODB.Recordset                    '临时使用动态集
    Dim Rec_Grid As New ADODB.Recordset                    '临时使用动态集
    
    '非数据行退出
    If CxbbGrid.Row < CxbbGrid.FixedRows Or Val(CxbbGrid.TextMatrix(CxbbGrid.Row, 0)) = 0 Then
        Exit Sub
    End If
    
     '取最后一条
    str_id = CxbbGrid.TextMatrix(CxbbGrid.Row, Sydz("001", GridStr(), Szzls))
    For int_zgh = CxbbGrid.Row To CxbbGrid.Rows - 1
       If CxbbGrid.TextMatrix(int_zgh, Sydz("001", GridStr(), Szzls)) <> "" Then
           If CxbbGrid.TextMatrix(int_zgh, Sydz("001", GridStr(), Szzls)) <> str_id Then
               Exit For
           End If
       End If
    Next
    CxbbGrid.Row = int_zgh - 1
    
    '判断所查询的是否是真正最后一条
    Sqlstr = "SELECT * From Rs_Change Where EmpID=" & Val(CxbbGrid.TextMatrix(CxbbGrid.Row, Sydz("001", GridStr(), Szzls)))
    Set Rec_Grid = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
    With Rec_Grid
        If .EOF Then
            Tsxx = "此记录已被其他用户删除!"
            Call Xtxxts(Tsxx, 0, 3)
            Exit Sub
        Else
            .MoveLast
            If .Fields("SNo") <> CxbbGrid.TextMatrix(CxbbGrid.Row, Sydz("002", GridStr(), Szzls)) Then
                Tsxx = "此职工的变动记录不是最后一条，不能删除!"
                Call Xtxxts(Tsxx, 0, 1)
                Exit Sub
            End If
        
            '判断是否是停用的记录
            If .Fields("ChangeType") = "1002" Then
                Tsxx = "此职工已经调出，不能操作!"
                Call Xtxxts(Tsxx, 0, 1)
                Exit Sub
            End If
        End If
     End With
    
    Tsxx = "请确认是否删除此职工的最后变动记录?"
    Yhanswer = Xtxxts(Tsxx, 2, 2)
    
    If Yhanswer = 1 Then
        
        '1.判断当前单据是否允许删除
        If Not Fun_AllowDelete Then
            Exit Sub
        End If
        
        '2.删除单据所有内容
        Lng_BillID = CxbbGrid.TextMatrix(CxbbGrid.Row, Sydz("001", GridStr(), Szzls))
        
        '还原Rs_BasicInfo(人事基本信息的内容)
        
        If RecTemp.State = 1 Then RecTemp.Close
        RecTemp.Open "Select Rs_BasicInfo.* From Rs_BasicInfo WHERE Rs_BasicInfo.EmpID='" & Lng_BillID & "' and Rs_BasicInfo.YNStop='0'", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
        If RecTemp.RecordCount = 0 Then Exit Sub
        With RecTemp
            If str_Grid(CxbbGrid.Row, Sydz("008", GridStr(), Szzls)) <> "" Then
              .Fields("DeptCode") = str_Grid(CxbbGrid.Row, Sydz("008", GridStr(), Szzls))                                  '部门代码
            Else
              .Fields("DeptCode") = ""
            End If
            If str_Grid(CxbbGrid.Row, Sydz("010", GridStr(), Szzls)) <> "" Then
              .Fields("Business") = str_Grid(CxbbGrid.Row, Sydz("010", GridStr(), Szzls))                                   '职务
            Else
              .Fields("Business") = ""
            End If
            If str_Grid(CxbbGrid.Row, Sydz("012", GridStr(), Szzls)) <> "" Then
              .Fields("Position") = str_Grid(CxbbGrid.Row, Sydz("012", GridStr(), Szzls))                                   '岗位
            Else
              .Fields("Position") = ""
            End If
            If str_Grid(CxbbGrid.Row, Sydz("014", GridStr(), Szzls)) <> "" Then
              .Fields("WorkType") = str_Grid(CxbbGrid.Row, Sydz("014", GridStr(), Szzls))                                    '工种
            Else
              .Fields("WorkType") = ""
            End If
            If str_Grid(CxbbGrid.Row, Sydz("018", GridStr(), Szzls)) <> "" Then
              .Fields("HireProp") = str_Grid(CxbbGrid.Row, Sydz("018", GridStr(), Szzls))                                    '用工性质
            Else
              .Fields("HireProp") = ""
            End If
            If str_Grid(CxbbGrid.Row, Sydz("016", GridStr(), Szzls)) <> "" Then
              .Fields("EmpSort") = str_Grid(CxbbGrid.Row, Sydz("016", GridStr(), Szzls))                                     '类别
            Else
              .Fields("EmpSort") = ""
            End If
            .Update
        End With
        On Error GoTo Swcwcl
        
        Cw_DataEnvi.DataConnect.BeginTrans
        Cw_DataEnvi.DataConnect.Execute ("Delete Rs_Change Where EmpID='" & Lng_BillID & "' and SNo='" & CxbbGrid.TextMatrix(CxbbGrid.Row, Sydz("002", GridStr(), Szzls)) & "'")
        Cw_DataEnvi.DataConnect.CommitTrans
        
        '删除网格中单据数据
        CxbbGrid.RemoveItem (CxbbGrid.Row)
    Else
        Exit Sub
    End If
    
    Exit Sub
Swcwcl:
    Cw_DataEnvi.DataConnect.RollbackTrans
    Tsxx = "删除过程中出现未知错误,程序自动恢复删除前状态!"
    Call Xtxxts(Tsxx, 0, 1)
    Exit Sub
    
End Sub

Private Function Fun_AllowDelete() As Boolean                                        '判断当前单据是否允许删除
    
    Dim RecTemp As New ADODB.Recordset     '临时使用动态集
    Dim Sqlstr As String                   '查询字符串
    Dim Lng_BillID As Long                 '单据ID
    
    Lng_BillID = Val(CxbbGrid.TextMatrix(CxbbGrid.Row, Sydz("001", GridStr(), Szzls)))
    Sqlstr = "Select * From Rs_Change Where EmpID=" & Lng_BillID
    Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
    With RecTemp
        If Not .EOF Then
        
        
        End If
    End With
    Fun_AllowDelete = True
    
End Function

Private Sub bbyl(bbylte As Boolean)                    '报表打印预览
    
    Dim Bbzbt$, Bbxbt() As String, bbxbtzzxs() As Integer, Bbxbtgs As Integer
    Dim Bbbwh() As String, Bbbwhzzxs() As Integer, Bbbwhgs As Integer
    Bbxbtgs = 1                                          '报 表 小 标 题 行 数
    Bbbwhgs = 0                                          '报 表 表 尾 行 数
    
    ReDim Bbxbt(1 To Bbxbtgs)
    ReDim bbxbtzzxs(1 To Bbxbtgs)
    If Bbbwhgs <> 0 Then
        ReDim Bbbwh(1 To Bbbwhgs)
        ReDim Bbbwhzzxs(1 To Bbbwhgs)
    End If
    
    Bbzbt = ReportTitle
    Bbxbt(1) = ""
    bbxbtzzxs(1) = 0                                     '报表行组织形式(0-居左 1-居中 2-居右)
    Call Scyxsjb(CxbbGrid)                               '生成报表数据
    Call Scdybb(Dyymctbl, Bbzbt, Bbxbt(), bbxbtzzxs(), Bbxbtgs, Bbbwh(), Bbbwhzzxs(), Bbbwhgs, bbylte)
    If Not bbylte Then
        Unload DY_Tybbyldy
    End If
    
End Sub