+

VB开发的ERP系统

            End If
            Lbl_Count.Caption = "共" & .Rows - .FixedRows & "人"
        End With
        
    End With
    
    Exit Sub
Err1:
    Cw_DataEnvi.DataConnect.RollbackTrans
    
End Sub
Private Sub AddEmp()
    Dim SqlT As String
    Dim coll As New Collection
    Dim Scount() As String    '存放每个类别增加的人员数
    Dim sqlF As String
    Sql = ""
    '增加人员
    With Query_Frm
        Set .collTableName = coll
        .QueryTableSql = " ltrim(rtrim(TableName))= 'rs_basicInfo' or ltrim(rtrim(TableName))= 'rs_ExtendInfo'"
        .Show 1
        If .bChecked = True Then
            ICondition = .sSqlWhere
        Else
            Exit Sub
        End If
        
        If Trim(ICondition) = "" Then
            '没有选择查询条件
            SqlT = " from Rs_BasicInfo where ynstop=0 "
        Else
            SqlT = " from rs_basicInfo,rs_ExtendInfo where rs_basicInfo.EmpId=rs_ExtendInfo.EmpId and (" & _
                    ICondition & ")  and ynstop=0 "
        End If
    End With
    
    If ImgCbo_Sort.ComboItems.Count > 1 Then  '当操作员可操作的类别大于一个时。
        With Pub_FrmSortChoice
            .Show 1
            If LCase(Trim(.OpeStatus)) = "cancel" Then
                Exit Sub
            Else
                For i = 1 To .cSort.Count
                    Sql = Sql & " insert PM_SortEmp(SortId,EmpID,HaltFlag) select '" & .cSort.Item(i) & "'," & _
                        " rs_basicInfo.EmpID,0  " & SqlT & " and rs_basicInfo.EmpId not in (select EmpId from " & _
                        " pm_SortEmp where SortId='" & .cSort.Item(i) & "')" & _
                        " and rs_basicInfo.EmpId in ( select EmpID from Rs_BasicInfo r inner join PM_OpeDept p on r.DeptCode=p.DeptCode " & _
                        " and Czybm='" & Xtczybm & "')"

                Next
            End If
        End With
    Else  '只有一个类别
        Sql = " insert PM_SortEmp(SortId,EmpID,HaltFlag) select '" & SortId & "'," & " rs_basicInfo.EmpID,0 " & SqlT & _
              " and rs_basicInfo.EmpId not in (select EmpId from pm_SortEmp where SortId='" & SortId & "')" & _
              " and rs_basicInfo.EmpId in ( select EmpID from Rs_BasicInfo r  inner join PM_OpeDept p on r.DeptCode=p.DeptCode " & _
              " and Czybm='" & Xtczybm & "')"
    End If
    On Error GoTo Err1
    Cw_DataEnvi.DataConnect.BeginTrans
    If ImgCbo_Sort.ComboItems.Count > 1 Then
        With Pub_FrmSortChoice
            ReDim Scount(.cSort.Count - 1, 2)
            For i = 1 To .cSort.Count
                sqlF = "select '" & .cSort.Item(i) & "'," & _
                      " rs_basicInfo.EmpID,0  " & SqlT & " and rs_basicInfo.EmpId not in (select EmpId from " & _
                      " pm_SortEmp where SortId='" & .cSort.Item(i) & "')" & _
                      " and rs_basicInfo.EmpId in ( select EmpID from Rs_BasicInfo r inner join PM_OpeDept p on r.DeptCode=p.DeptCode " & _
                      " and Czybm='" & Xtczybm & "')"
                      
                If Rsc.State = 1 Then Rsc.Close
                Set Rsc = Cw_DataEnvi.DataConnect.Execute(sqlF)
                Scount(i - 1, 0) = Trim(.cSort.Item(i))
                Scount(i - 1, 1) = Rsc.RecordCount
                If Rsc.State = 1 Then Rsc.Close
                sqlF = "select * from pm_sort where sortid='" & .cSort.Item(i) & "'"
                Set Rsc = Cw_DataEnvi.DataConnect.Execute(sqlF)
                Scount(i - 1, 2) = Trim(Rsc!SortName)
            Next
        End With
    Else
        sqlF = "select '" & SortId & "'," & " rs_basicInfo.EmpID,0 " & SqlT & _
            " and rs_basicInfo.EmpId not in (select EmpId from pm_SortEmp where SortId='" & SortId & "')" & _
            " and rs_basicInfo.EmpId in ( select EmpID from Rs_BasicInfo r inner join PM_OpeDept p on r.DeptCode=p.DeptCode " & _
            " and Czybm='" & Xtczybm & "')"
        If Rsc.State = 1 Then Rsc.Close
        Set Rsc = Cw_DataEnvi.DataConnect.Execute(sqlF)
        ReDim Scount(0, 2)
        Scount(0, 0) = Trim(SortId)
        Scount(0, 1) = Rsc.RecordCount
        If Rsc.State = 1 Then Rsc.Close
        sqlF = "select * from pm_sort where sortid='" & SortId & "'"
        Set Rsc = Cw_DataEnvi.DataConnect.Execute(sqlF)
        Scount(0, 2) = Trim(Rsc!SortName)
    End If
    Cw_DataEnvi.DataConnect.Execute Sql
    Cw_DataEnvi.DataConnect.CommitTrans
    For i = 0 To UBound(Scount)
        Call Xtxxts("工资类别“" & Scount(i, 2) & "”新增" & Scount(i, 1) & "人", 0, 4)
    Next
    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 & "' order by r.DeptCode,EmpNo"
    Call Cxnrtcwg(Sql)
    QCondition = ""
    Exit Sub
Err1:
    Cw_DataEnvi.DataConnect.RollbackTrans
    Call Xtxxts("增加不成功!", 0, 1)
End Sub
Private Sub Squery()
    '查询
    Dim SqlT As String
    Dim coll As New Collection
    
    With CzxsGrid
        If .Rows = .FixedRows Then
            Exit Sub
        End If
    End With
    
    With Query_Frm
        Set .collTableName = coll
        .QueryTableSql = " ltrim(rtrim(TableName))= 'rs_basicInfo' or ltrim(rtrim(TableName))= 'rs_ExtendInfo'"
        .Show 1
        If .bChecked = True Then
            QCondition = .sSqlWhere
        Else
            Exit Sub
        End If
        If Trim(QCondition) = "" Then
            '没有选择查询条件
            SqlT = " from Pm_SortEmp  where SortId='" & SortId & "'"
        Else
            If coll.Count = 1 Then
                SqlT = " from Pm_SortEmp p," & coll.Item(1) & _
                       " where  p.EmpID=" & coll.Item(1) & ".EmpID" & _
                       " and (" & Trim(QCondition) & ")"
            Else
                SqlT = " from Pm_SortEmp p,rs_basicInfo,rs_ExtendInfo" & _
                       " where rs_basicInfo.EmpId=rs_ExtendInfo.EmpID " & _
                       " and p.EmpID=rs_basicInfo.EmpId and (" & QCondition & ")  "
            End If
        End If
        SqlT = " select p.EmpID " & SqlT
        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 (" & SqlT & _
              ") 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)
    End With
End Sub
Private Sub toolEnable()
    With SzToolbar
        .Buttons("zj").Enabled = True
        .Buttons("cx").Enabled = True
        .Buttons("all").Enabled = True
        .Buttons("stop").Enabled = True
        .Buttons("resume").Enabled = True
        .Buttons("sc").Enabled = True
    End With
End Sub
Private Sub toolUnEnable()
    With SzToolbar
        .Buttons("zj").Enabled = False
        .Buttons("cx").Enabled = False
        .Buttons("all").Enabled = False
        .Buttons("stop").Enabled = False
        .Buttons("resume").Enabled = False
        .Buttons("sc").Enabled = False
    End With
End Sub
Private Sub Wbkcl()                                                 '文本框录入之前处理(根据实际情况)
 
    Dim xswbrr As String
 
    With CzxsGrid
        Zdlrqnr = Trim(.Text)
        xswbrr = Trim(.Text)
    
        If GridBoolean(.Col, 3) Then   '列表框录入
    
            '填充列表框程序
            Call FillCombo(YdCombo, GridStr(.Col, 5), xswbrr, 0)
        Else
            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)        '录入数据字段有效性判断,同时进行字段录入事后处理
    
    Dim Str_JudgeText As String            '临时有效性判断字段内容
    Dim Coljsq As Long                     '临时列计数器
    Dim RecTemp As New ADODB.Recordset     '临时使用动态集
    Dim Dbl_Qcye As Double                 '临时期初余额
 
    With CzxsGrid
    
        '非录入状态有效性为合法
        If Yxxpdlock Or .Row < .FixedRows Then
           sjzdyxxpd = True
           Exit Function
        End If
 
        Str_JudgeText = Trim(.TextMatrix(Dqpdwgh, Dqpdwgl))
        Select Case GridStr(Dqpdwgl, 1)
         
            '以下为自定义部分[
                '1.放置字段有效性判断程序
                    Case "006", "007"
                        '账号不能重复
                        If Rsc.State = 1 Then Rsc.Close
                        Sql = " select p.*,EmpNO,EmpName,s.SortName from PM_SortEmp p,rs_BasicInfo r " & _
                              ", Pm_Sort s where p.EmpID=r.EmpId and p.SortId=s.SortID and p.EmpId<>" & _
                            .TextMatrix(Dqpdwgh, 0) & " and BankCode='" & _
                            .TextMatrix(Dqpdwgh, 1) & "' and accounts='" & _
                            .TextMatrix(Dqpdwgh, Dqpdwgl) & "' and ltrim(rtrim(accounts))<>''"
                        Set Rsc = Cw_DataEnvi.DataConnect.Execute(Sql)
                        If Not Rsc.EOF Then
                            Tsxx = .TextMatrix(Dqpdwgh, Sydz("003", GridStr(), Szzls)) & "号" & _
                                   .TextMatrix(Dqpdwgh, Sydz("004", GridStr(), Szzls)) & _
                                   "的银行账号与" & Trim(Rsc!EmpNo) & "号" & _
                                   Trim(Rsc!EmpName) & "的银行账号重复!" & _
                                   Chr(10) & Chr(13) & "请在各个工资类别中查看。"
                            GoTo Lrcwcl
                        End If
                '2.放置字段事后处理程序
                
            '以上为自定义部分]
            
        End Select
     
        '字段录入正确后为零字段清空
        Call Qkwlzd(Dqpdwgh, Dqpdwgl)
    
        sjzdyxxpd = True
        Yxxpdlock = True
        Exit Function
    
    End With
  
Lrcwcl:    '录入错误处理

    With CzxsGrid
        Call Xtxxts(Tsxx, 0, 1)
        Changelock = True
        .Select Dqpdwgh, Dqpdwgl
        Changelock = False
        Call xswbk
        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                   '临时查询字符串
    Dim Str_Ccode As String                '临时索引编码
    Dim BankCode As String                 '修改账号人员对应的代发银行
    Dim EmpID As String                    '修改账号人员的ID号

    With CzxsGrid

        '行没有发生变化则不进行有效性判断
        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