+

VB开发的ERP系统

            Dyymctbl.Show 1
        Case "yl"                                            '预 览
            Call bbyl(True)
        Case "dy"                                            '打 印
            Call bbyl(False)
        Case "zj"                                            '增 加
            '判断用户是否有此功能执行权限,如有则写上机日志(进入)
            If Not Security_Log(Str_RightEdit, Xtczybm, 1, True) Then
                Exit Sub
            End If
            
            Call AddEmp
        Case "cx"                                            '查 询
             Squery
        Case "all"                                           '全 选
            With CzxsGrid
                If .Rows > .FixedRows Then
                    .Row = .FixedRows
                    .RowSel = .Rows - 1
                End If
            End With
        Case "stop"                                          '停 发
            Call StopH(1)
        Case "resume"                                        '恢 复
            Call StopH(0)
        Case "sc"                                            '删 除
            '判断用户是否有此功能执行权限,如有则写上机日志(进入)
            If Not Security_Log(Str_RightEdit, Xtczybm, 1, True) Then
                Exit Sub
            End If
            Call DelEmp
        Case "bank"                                          '银 行
            '判断用户是否有此功能执行权限,如有则写上机日志(进入)
            If Not Security_Log(Str_RightBank, Xtczybm, 1, True) Then
                Exit Sub
            End If
            BankChoice
        Case "sx"                                            '刷 新
            Sql = "select p.EmpId,r.DeptCode,DeptName,EmpNO,EmpName,haltFlag,p.BankCode,BankName,p.Accounts from " & _
                  " gy_department d inner join rs_BasicInfo r on d.deptcode=r.deptcode " & _
                  " inner join pm_sortEmp p on p.empid=r.empid left join pm_Bank b on  " & _
                  " p.BankCode=b.BankCode " & _
                  " where sortid='" & SortId & "' and p.EmpId in ( select EmpID from Rs_BasicInfo r inner join PM_OpeDept p on r.DeptCode=p.DeptCode " & _
                  " and Czybm='" & Xtczybm & "') order by r.DeptCode,EmpNo"
            Call Cxnrtcwg(Sql)
        Case "bz"                                            '帮 助
            Call F1bz
        Case "fh"                                            '退 出
            Unload Me
    End Select
    '解 锁
    Valilock = False
    Changelock = False
End Sub
Private Sub BankChoice()
    Dim SqlT As String
    With CzxsGrid
        If .Rows = .FixedRows Then
            Exit Sub
        End If
    End With
    SqlT = SqlCon
    With Class_FrmBank
        .Show 1
        If .OpeStatus = "cancel" Then
            Exit Sub
        End If
        '判断银行账号是否有重复的。
        With CzxsGrid
            If .Row <= .RowSel Then
                For i = .Row To .RowSel
                    If BankA(i) = False Then
                        Exit Sub
                    End If
                Next
            Else
                For i = .RowSel To .Row
                    If BankA(i) = False Then
                        Exit Sub
                    End If
                Next
            End If
            
        End With
        
        If ImgCbo_Sort.ComboItems.Count > 1 Then
            With Pub_FrmSortChoice
                .Show 1
                If .OpeStatus = "cancel" Then
                    Exit Sub
                End If
                .SortId = SortId
                Sql = ""
                If LCase(Trim(Class_FrmBank.BankCode)) = "c" Then
                    '清空银行
                    BankCode = ""
                    For i = 1 To .cSort.Count
                        Sql = Sql & " update Pm_SortEmp set BankCode='" & _
                              BankCode & "',Accounts='' where sortid='" & _
                               .cSort.Item(i) & "' and EmpId in " & SqlT
                    Next
                Else
                    BankCode = Class_FrmBank.BankCode
                    For i = 1 To .cSort.Count
                        Sql = Sql & " update Pm_SortEmp set BankCode='" & _
                            BankCode & "' where sortid='" & _
                            .cSort.Item(i) & "' and EmpId in " & SqlT
                    Next
                End If
            End With
        Else
            If LCase(Trim(Class_FrmBank.BankCode)) = "c" Then
                Sql = " update Pm_SortEmp set BankCode='' " & _
                      ",Accounts=''  where sortid='" & _
                      SortId & "' and EmpId in  " & SqlT
            Else
                Sql = " update Pm_SortEmp set BankCode='" & _
                      Class_FrmBank.BankCode & "' where sortid='" & _
                      SortId & "' and EmpId in " & SqlT
            End If
        End If
        
    End With
    On Error GoTo Err1
    With Cw_DataEnvi.DataConnect
        .BeginTrans
        .Execute Sql
        .CommitTrans
    End With
    With CzxsGrid
        If .Row <= .RowSel Then
            Call bankB(i, .Row, .RowSel)
        Else
            Call bankB(i, .RowSel, .Row)
        End If
    End With
    Exit Sub
Err1:
    Cw_DataEnvi.DataConnect.RollbackTrans
End Sub
Private Sub bankB(i As Long, row1 As Long, row2 As Long)
    With CzxsGrid
        If LCase(Trim(Class_FrmBank.BankCode)) = "c" Then
            For i = row1 To row2
                .TextMatrix(i, 1) = ""
                .TextMatrix(i, Sydz("006", GridStr(), Szzls)) = ""
                .TextMatrix(i, Sydz("007", GridStr(), Szzls)) = ""
            Next
        Else
            For i = row1 To row2
                .TextMatrix(i, 1) = Class_FrmBank.BankCode
                .TextMatrix(i, Sydz("006", GridStr(), Szzls)) = Class_FrmBank.BankName
            Next
        End If
    End With
End Sub
Private Function BankA(i As Long) As Boolean
    With CzxsGrid
        If Trim(.TextMatrix(i, Sydz("007", GridStr(), Szzls))) <> "" Then
            If Rsc.State = 1 Then Rsc.Close
            Sql = " select p.*,EmpNO,EmpName,SortName from PM_SortEmp p inner join rs_BasicInfo r " & _
                " on p.EmpID=r.EmpID inner join PM_sort s on p.Sortid=S.sortid " & _
                "where BankCode='" & _
                Class_FrmBank.BankCode & "' and Accounts='" & _
                .TextMatrix(i, Sydz("007", GridStr(), Szzls)) & _
                "' and p.EmpID <>" & .TextMatrix(i, 0)
            Set Rsc = Cw_DataEnvi.DataConnect.Execute(Sql)
            If Not Rsc.EOF Then
                Call Xtxxts("将" & Trim(.TextMatrix(i, Sydz("006", GridStr(), Szzls))) & _
                            "换成" & Trim(Class_FrmBank.BankName) & "时，" & Chr(10) & _
                            Chr(13) & Trim(.TextMatrix(i, Sydz("003", GridStr(), Szzls))) & _
                           "号" & Trim(.TextMatrix(i, Sydz("004", GridStr(), Szzls))) & _
                           "与" & Trim(Rsc!EmpNo) & "号" & _
                           Trim(Rsc!EmpName) & "的银行账号重复，" & Chr(10) & Chr(13) & _
                           "请先将该行的银行名称清空，再改写银行!" & _
                           "请在各个工资类别中查看。", 0, 1)
                BankA = False
                Exit Function
            End If
        End If
    End With
    BankA = True
End Function
Private Sub StopH(StopH As String)
    '判断用户是否有此功能执行权限,如有则写上机日志(进入)
    If Not Security_Log(Str_RightEdit, Xtczybm, 1, True) Then
        Exit Sub
    End If
    
    '1 停发 0 恢复
    Dim Sqlstr As String
    With CzxsGrid
        If .Rows = .FixedRows Or .Row <= .FixedRows - 1 Then
            Exit Sub
        End If
        
        Sql = SqlCon
        Sqlstr = ""
        If ImgCbo_Sort.ComboItems.Count > 1 Then
            With Pub_FrmSortChoice
                .Show 1
                If .OpeStatus = "cancel" Then
                    Exit Sub
                Else
                    For i = 1 To .cSort.Count
                       Sqlstr = Sqlstr & " update PM_SortEmp set haltFlag=" & StopH & "  where  sortid ='" & _
                           .cSort.Item(i) & "' and EmpId in " & Sql
                    Next
                End If
            End With
        Else
            Sqlstr = " update PM_SortEmp set haltFlag=" & StopH & " where  sortid ='" & _
                     SortId & "' and EmpId in " & Sql
        End If
    End With
    On Error GoTo Err1
    With Cw_DataEnvi.DataConnect
        .BeginTrans
        .Execute Sqlstr
        .CommitTrans
        With CzxsGrid
            If .Row <= .RowSel Then
                For i = .Row To .RowSel
                    .TextMatrix(i, Sydz("005", GridStr(), Szzls)) = StopH
                Next
            Else
                For i = .Row To .RowSel Step -1
                    .TextMatrix(i, Sydz("005", GridStr(), Szzls)) = StopH
                Next
            End If
        End With
    End With
    
    Exit Sub
Err1:
    Cw_DataEnvi.DataConnect.RollbackTrans
    
End Sub
Private Function SqlCon() As String
    With CzxsGrid
        Sql = "("
        If .Row <= .RowSel Then
            For i = .Row To .RowSel
                Sql = Sql & Val(.TextMatrix(i, 0)) & ","
            Next
        Else
            For i = .RowSel To .Row
                Sql = Sql & Val(.TextMatrix(i, 0)) & ","
            Next
        End If
        If Trim(Sql) <> "(" Then
            Sql = Left(Trim(Sql), Len(Trim(Sql)) - 1) & ")"
        Else
            Sql = ""
        End If
        SqlCon = Sql
    End With
End Function
Private Sub DelEmp()
    '删除
    Dim Sqlstr As String
    Dim Yhanswer As Integer
    With CzxsGrid
        If .Rows = .FixedRows Then
            Exit Sub
        End If
    End With
    Sql = SqlCon
    Tsxx = "请确认是否删除所选记录?"
    Yhanswer = Xtxxts(Tsxx, 2, 2)
    
    If Yhanswer = 2 Then
        Exit Sub
    End If
    
    With CzxsGrid
        Sqlstr = ""
        If ImgCbo_Sort.ComboItems.Count > 1 Then
            With Pub_FrmSortChoice
                .Show 1
                If .OpeStatus = "cancel" Then
                    Exit Sub
                Else
                    For i = 1 To .cSort.Count
                       Sqlstr = Sqlstr & " delete PM_SortEmp where  sortid ='" & _
                           .cSort.Item(i) & "' and EmpId in " & Sql
                    Next
                End If
            End With
        Else
            Sqlstr = " delete PM_SortEmp where  sortid ='" & _
                     SortId & "' and EmpId in " & Sql
        End If
    End With
    On Error GoTo Err1
    With Cw_DataEnvi.DataConnect
        .BeginTrans
        .Execute Sqlstr
        .CommitTrans
        With CzxsGrid
            If .Row <= .RowSel Then
                For i = .Row To .RowSel
                    .RemoveItem (.Row)
                Next
            Else
                For i = .RowSel To .Row
                    .RemoveItem (.RowSel)
                Next