+

VB开发的ERP系统

    End If
    '编辑(新增、修改、删除)权限索引
    Str_RightEdit = "Pm_Sort_edit"
End Sub
 
Private Sub Cxnrtcwg()                               '查询内容填充网格

    Dim Sqlstr As String              '查询连接串
    Dim jsqte As Long                 '查询临时使用变量
  
    '为加快显示速度,将网格刷新动作冻结
    CzxsGrid.Redraw = False
  
    '[>>查询连接串
    Sqlstr = "SELECT * FROM Pm_Sort order by SortId"
    '<<]
    Set Cxnrrec = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
    
    With Cxnrrec
        CzxsGrid.Rows = CzxsGrid.FixedRows
        If .EOF And .BOF Then
            CzxsGrid.Redraw = True
            Exit Sub
        End If
        
        jsqte = CzxsGrid.FixedRows
        
        Do While Not .EOF
            CzxsGrid.AddItem ""
            Call Jltcwg(Cxnrrec, jsqte)                              '调入填充网格子过程
            CzxsGrid.RowHeight(jsqte) = Sjhgd                        '设置网格高度
            .MoveNext
            jsqte = jsqte + 1
        Loop
    End With
  
    '将网格刷新动作解冻
    CzxsGrid.Redraw = True
    
End Sub

Private Sub Jltcwg(Jlbrec As ADODB.Recordset, Rowjsq As Long)           '记录内容填充网格

    '[>>以下为自定义部分
    With Jlbrec
        CzxsGrid.TextMatrix(Rowjsq, Sydz("001", GridStr(), Szzls)) = Trim(.Fields("SortID") & "")            '工资类别编号
        CzxsGrid.TextMatrix(Rowjsq, Sydz("002", GridStr(), Szzls)) = Trim(.Fields("SortName") & "")          '工资类别名称
        CzxsGrid.TextMatrix(Rowjsq, Sydz("003", GridStr(), Szzls)) = Trim(.Fields("AdmDeductTax") & "")      '允许扣税
        CzxsGrid.TextMatrix(Rowjsq, Sydz("004", GridStr(), Szzls)) = Trim(.Fields("DeductTax") & "")         '在本类别扣税
        CzxsGrid.TextMatrix(Rowjsq, Sydz("005", GridStr(), Szzls)) = Trim(.Fields("NeedExtra") & "")         '扣税时需附加费用
        CzxsGrid.TextMatrix(Rowjsq, Sydz("006", GridStr(), Szzls)) = Trim(.Fields("DataCopy") & "")          '复制本类别数据
        CzxsGrid.TextMatrix(Rowjsq, Sydz("007", GridStr(), Szzls)) = Trim(.Fields("HaltFlag") & "")          '计算停发人员工资
        CzxsGrid.TextMatrix(Rowjsq, Sydz("008", GridStr(), Szzls)) = Trim(.Fields("CSortId") & "")           '对应扣税类别
        CzxsGrid.TextMatrix(Rowjsq, Sydz("009", GridStr(), Szzls)) = Trim(.Fields("SortHalt") & "")          '停用
    End With
    '以上为自定义部分<<]
    
End Sub

Private Sub Form_Unload(Cancel As Integer)             '窗体卸载

    Set Cxnrrec = Nothing
    Set Rec_CodeSet = Nothing
    Unload Dyymctbl
   
End Sub

Private Function Bclrsj() As Boolean                   '判断录入数据有效性,并保存数据

    Dim jsqte As Integer
    Dim Rsc As New ADODB.Recordset
  
    '对文本框录入内容进行为零和为空判断(固定不变)
    With Rec_CodeSet
    
        For jsqte = 0 To Max_Text_Index
            If Textint(jsqte, 8) = 1 Then     '字段不能为空
                If Len(Trim(LrText(jsqte).Text)) = 0 Then
                    Tsxx = Textstr(jsqte, 7) & "不能为空!"
                    Call Xtxxts(Tsxx, 0, 1)
                    LrText(jsqte).SetFocus
                    Bclrsj = False
                    Exit Function
                End If
            Else
                If Textint(jsqte, 8) = 2 Then   '字段不能为零
                    If Val(Trim(LrText(jsqte).Text)) = 0 Then
                        Tsxx = Textstr(jsqte, 7) & "不能为零!"
                        Call Xtxxts(Tsxx, 0, 1)
                        LrText(jsqte).SetFocus
                        Bclrsj = False
                        Exit Function
                    End If
                End If
            End If
        Next jsqte
    
        '对需要进行事后判断的文本框录入内容进行有效性判断 (固定不变)
        For jsqte = 0 To Max_Text_Index
            If Textint(jsqte, 9) = 0 Or Textint(jsqte, 9) = 2 Then
                If Not TextYxxpd(jsqte) Then
                    Exit Function
                End If
            End If
        Next jsqte
        
        If Len(Trim(LrText(0))) < 3 Or Not IsNumeric(LrText(0)) Then
            Call Xtxxts("工资类别编号必须是三位数字!", 0, 1)
            LrText(0).SetFocus
            LrText(0).SelStart = 0
            LrText(0).SelLength = Len(Trim(LrText(0)))
            Exit Function
        End If
   
        '“允许扣税”属性为真时，对应扣税类别不能空
        If Chk_Adm And Trim(ImgCbo_Sort.Text) = "" Then
            Call Xtxxts("选中“允许扣税”，对应扣税类别不能空!", 0, 1)
            Exit Function
        End If
        
        If Chk_Tax And Trim(ImgCbo_Sort.Text) = "" Then
            Call Xtxxts("选中“在本类别扣税”，则必须选中“允许扣税”!", 0, 1)
            Exit Function
        End If
        
        '"在本类别扣税"为真，则它对应的扣税类别必须是它本身
        If Chk_Tax And Trim(ImgCbo_Sort.Text) <> "" And Left(Trim(ImgCbo_Sort.Text), 3) <> Trim(LrText(0)) Then
            Call Xtxxts("选中“在本类别扣税”，则它对应的扣税类别必须是它本身!", 0, 1)
            Exit Function
        End If
        
        '"在本类别扣税"为假，则它对应的扣税类别不能是它本身
        If Chk_Tax = 0 And Trim(ImgCbo_Sort.Text) = Trim(LrText(0)) & Space(1) & Trim(LrText(1)) Then
            Call Xtxxts("“在本类别扣税”为假，则它对应的扣税类别不能是它本身!", 0, 1)
            Exit Function
        End If
        '只有工资数据表中的当前会计期间、本类别的数据清空，才能停用
        If Chk_Stop Then
            If Rsc.State = 1 Then Rsc.Close
            Sql = "select * from Pm_Payroll where kjyear=" & KjYear & " and period=" & Period & " and sortid ='" & Trim(LrText(0)) & "'"
            Set Rsc = Cw_DataEnvi.DataConnect.Execute(Sql)
            If Not Rsc.EOF Then
                Call Xtxxts("工资表中有当前会计期间本类别的数据，本类别不能停用!" & Chr(10) & Chr(13) & _
                "有以下两种办法可将工资表中的相应数据清空:" & Chr(10) & Chr(13) & _
                "1、在“类别人员选择”模块中将本类别的人员全部清空,然后执行工资计算功能;" & Chr(10) & Chr(13) & _
                "2、将本类别的“计算停发人员工资”置空,在“类别人员选择”中将本类别的人员全部停发,然后执行工资计算功能。", 0, 1)
                Exit Function
            End If
        End If
        
        
        If Lrzt = 1 Then  '增 加
        
            '[>>判断编码是否重复
            If .State = 1 Then .Close
            .Open "SELECT * FROM PM_Sort WHERE SortID= '" + Trim(LrText(0).Text) + "'", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
    
            If Not .EOF Then
                Tsxx = "工资类别编号重复!"
                Call Xtxxts(Tsxx, 0, 1)
                LrText(0).SetFocus
                Bclrsj = False
                Exit Function
            End If
    
            '判断名称是否重复
            If .State = 1 Then .Close
            .Open "SELECT * FROM PM_Sort WHERE SortName= '" + Trim(LrText(1).Text) + "'", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
    
            If Not .EOF Then
                Tsxx = "工资类别名称重复!"
                Call Xtxxts(Tsxx, 0, 1)
                LrText(1).SetFocus
                Bclrsj = False
                Exit Function
            End If

            '判断记录内容无误后,将记录内容写入数据表
            On Error GoTo Swcwcl
    
            Cw_DataEnvi.DataConnect.BeginTrans
   
            .AddNew
            .Fields("SortID") = Trim(LrText(0).Text)    '工资类别编号
            .Fields("SortName") = Trim(LrText(1).Text)    '工资类别名称
            .Fields("AdmDeductTax") = Chk_Adm.Value     '允许扣税
            .Fields("DeductTax") = Chk_Tax.Value     '在本类别扣税
            .Fields("NeedExtra") = Chk_Extra    '扣税时需附加费用
            .Fields("DataCopy") = Chk_Copy    '复制本类别数据
            .Fields("HaltFlag") = Chk_Halt    '计算停发人员工资
            .Fields("CSortID") = Left(Trim(ImgCbo_Sort.Text), 3) & ""  '对应扣税类别
            .Fields("SortHalt") = Chk_Stop    '停用
            .Update
            If Chk_Tax Then
               Call TaxPaywage    '将tax、paywage、taxitem加到pm_SortItem中
            End If
            
            If Not Chk_Tax And Chk_Adm Then
               Call TaxPay("taxitem")
            End If
            Cw_DataEnvi.DataConnect.CommitTrans

            '将记录加入网格
            Sqlstr = "SELECT * FROM PM_Sort WHERE SortId= '" + Trim(LrText(0).Text) + "'"
            Set Cxnrrec = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
   
            With CzxsGrid
                .AddItem ""
                .RowHeight(.Rows - 1) = Sjhgd
                .Select .Rows - 1, Qslz
                Call Jltcwg(Cxnrrec, .Rows - 1)
            End With

            Tsxx = "保存完毕!"
            Call Xtxxts(Tsxx, 0, 4)
            
            Call Cshlrxx(1)
            LrText(0).SetFocus

            '将网格按编码排序
            With CzxsGrid
                .Col = Sydz("001", GridStr(), Szzls)
                CzxsGrid.Sort = flexSortStringAscending
            End With
            '<<]
    
        Else  '否则为修改记录
 
            If .State = 1 Then .Close
            .Open "SELECT * FROM PM_Sort WHERE SortName= '" + Trim(LrText(1).Text) + "' and SortID<>'" & Trim(LrText(0).Text) & "'", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic

            If Not .EOF Then
                Tsxx = "工资类别名称重复!"
                Call Xtxxts(Tsxx, 0, 1)
                LrText(1).SetFocus
        
                Bclrsj = False
                Exit Function
            End If

            On Error GoTo Swcwcl

            Cw_DataEnvi.DataConnect.BeginTrans

            If .State = 1 Then .Close
            .Open "SELECT * FROM PM_Sort WHERE SortId= '" + Trim(LrText(0).Text) + "'", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
     
            If Not .EOF Then
                .Fields("SortName") = Trim(LrText(1).Text)    '工资类别名称
                .Fields("AdmDeductTax") = Chk_Adm.Value       '允许扣税
                .Fields("DeductTax") = Chk_Tax.Value          '在本类别扣税
                .Fields("NeedExtra") = Chk_Extra              '扣税时需附加费用
                .Fields("DataCopy") = Chk_Copy                '复制本类别数据
                .Fields("HaltFlag") = Chk_Halt                '计算停发人员工资
                .Fields("CSortID") = Left(Trim(ImgCbo_Sort.Text), 3) & ""   '对应扣税类别
                .Fields("SortHalt") = Chk_Stop                '停用
                .Update
            End If
             
            Call AddSortItem("tax")
            Call AddSortItem("taxitem")
            Call AddSortItem("paywage")
            
            
            Cw_DataEnvi.DataConnect.CommitTrans
   
            '刷新当前网格
            Sqlstr = "SELECT * FROM PM_Sort WHERE SortId= '" + Trim(LrText(0).Text) + "'"
            Set Cxnrrec = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
   
            With CzxsGrid
                Call Jltcwg(Cxnrrec, .Row)
            End With
   
        End If
     
        '保存记录成功,函数返回真值
        Bclrsj = True
        
        Exit Function
        
    End With
 
Swcwcl:

     Cw_DataEnvi.DataConnect.RollbackTrans
     
     Tsxx = "存盘过程中出现错误,程序自动恢复保存前状态!"
     Call Xtxxts(Tsxx, 0, 1)
     
     Exit Function
     
End Function
Private Sub AddSortItem(FieldName As String)
    If Rsc.State = 1 Then Rsc.Close
    Sql = "select * from PM_SortItem p ,Rs_Items r where " & _
        "p.ItemID=r.ItemId and SortId='" & Trim(LrText(0)) & _
        "' and ltrim(rtrim(FieldName))='" & FieldName & "'"
    Set Rsc = Cw_DataEnvi.DataConnect.Execute(Sql)
    
    Select Case Chk_Tax.Value
       Case 1     '在本类别扣税
            If Not Rsc.EOF Then
                Sql = "Update PM_SortItem set HaltFlag=0 from PM_SortItem,Rs_Items R" & _
                     " where PM_SortItem.ItemID=R.ItemId and SortID='" & Trim(LrText(0)) & "'" & _
                     " and Fieldname='" & FieldName & "'"
                Cw_DataEnvi.DataConnect.Execute Sql
            Else    '本类别无个人税、实发工资、扣税项目这三个字段
                Call TaxPay(FieldName)
            End If
        Case 0    '不在本类别扣税,则将Tax、Paywage、taxitem这三个字段挂起
            If Not Rsc.EOF And FieldName <> "paywage" Then
                Sql = "Update PM_SortItem set HaltFlag=1 from PM_SortItem,Rs_Items R" & _
                     " where PM_SortItem.ItemID=R.ItemId and SortID='" & Trim(LrText(0)) & "'" & _
                     " and Fieldname='" & FieldName & "'"
                Cw_DataEnvi.DataConnect.Execute Sql
            End If
    End Select
    
    If Rsc.State = 1 Then Rsc.Close
    Sql = "select * from PM_SortItem p ,Rs_Items r where " & _
        "p.ItemID=r.ItemId and SortId='" & Trim(LrText(0)) & _
        "' and ltrim(rtrim(FieldName))='" & FieldName & "'"
    Set Rsc = Cw_DataEnvi.DataConnect.Execute(Sql)