salary.bas

金算盘软件代码

        'Set qrfSalaryTax = gclsBase.BaseDB.CreateQuery("CalcSalary2", strSql)
    'End If
    strSql = "CREATE OR REPLACE VIEW " & gclsBase.UID & ".CalcSalary2 AS " _
        & " SELECT CalcSalary1.lngEmployeeID,DECODE(CalcIsNew.blnNowNew,1,CalcIsNew.dblStartTaxRate," _
        & " PersonTax.dblTaxRate) AS dblTaxRate,DECODE(CalcIsNew.blnNowNew,1,0,PersonTax.dblDiscountTax)" _
        & " AS dblDiscountTax FROM CalcSalary1,CalcIsNew,PersonTax WHERE CalcIsNew.lngEmployeeID=" _
        & " CalcSalary1.lngEmployeeID AND PersonTax.dblAmount1<=CalcSalary1.SalaryTax1" _
        & " AND(PersonTax.dblAmount2=0 OR (PersonTax.dblAmount2<>0 " _
        & " AND CalcSalary1.SalaryTax1<PersonTax.dblAmount2))"
    gclsBase.BaseDB.Execute strSql
    '上次应纳税所得额的税率,速算扣除查询
    'strSql = "SELECT CalcSalary1.lngEmployeeID,IIF(CalcIsNew.blnLastNew,CalcIsNew.dblStartTaxRate," _
        & "PersonTax.dblTaxRate) AS dblTaxRate ,IIF(CalcIsNew.blnLastNew,0,PersonTax.dblDiscountTax)" _
        & " AS dblDiscountTax FROM (CalcSalary1 INNER JOIN CalcIsNew ON CalcIsNew.lngEmployeeID=" _
        & "CalcSalary1.lngEmployeeID)  LEFT JOIN PersonTax ON PersonTax.dblAmount1<=" _
        & "CalcSalary1.SalaryTax2 AND IIF(PersonTax.dblAmount2=0,True,CalcSalary1.SalaryTax2<PersonTax.dblAmount2)"
    'strErrorqrf = "CalcSalary3"
    'Set qrfSalaryTax = gclsBase.BaseDB.CreateQuery("CalcSalary3", strSql)
    'If strErrorqrf = "" Then
        'Set qrfSalaryTax = gclsBase.BaseDB.CreateQuery("CalcSalary3", strSql)
    'End If
    strSql = "CREATE OR REPLACE VIEW " & gclsBase.UID & ".CalcSalary3 AS " _
        & "SELECT CalcSalary1.lngEmployeeID," _
        & " DECODE(CalcIsNew.blnLastNew,1,CalcIsNew.dblStartTaxRate,PersonTax.dblTaxRate) AS dblTaxRate ," _
        & " DECODE(CalcIsNew.blnLastNew,1,0,PersonTax.dblDiscountTax) AS dblDiscountTax " _
        & " FROM CalcSalary1,CalcIsNew,PersonTax  " _
        & " WHERE CalcIsNew.lngEmployeeID=CalcSalary1.lngEmployeeID  " _
        & " AND PersonTax.dblAmount1<=CalcSalary1.SalaryTax2 " _
        & " And CalcSalary1.SalaryTax2< " _
        & " Decode(PersonTax.dblAmount2,0,99999999999999999999,PersonTax.dblAmount2)"
    gclsBase.BaseDB.Execute strSql
    '计算
    'strSql = "UPDATE SalaryData,CalcSalary1,CalcSalary2,CalcSalary3 SET SalaryData.dblNowTax" _
        & "=Format( (CalcSalary2.dblTaxRate*CalcSalary1.SalaryTax1/100-CalcSalary2.dblDiscountTax)" _
        & "-(CalcSalary3.dblTaxRate*CalcSalary1.SalaryTax2/100-CalcSalary3.dblDiscountTax) ,'#0.00' )" _
        & " WHERE SalaryData.lngEmployeeID=CalcSalary1.lngEmployeeID AND " _
        & "SalaryData.lngEmployeeID=CalcSalary2.lngEmployeeID AND SalaryData.lngEmployeeID" _
        & "=CalcSalary3.lngEmployeeID AND " & strWhere
    'gclsBase.BaseDB.Execute strSql
    '保证两位小数
    'strSql = "UPDATE Salarydata  set Salarydata.dblNowTax=format(Salarydata.dblNowTax,'##############0.00') Where " & strWhere
    'gclsBase.BaseDB.Execute strSql
'    strSql = "SELECT CalcSalary1.lngEmployeeID AS lngTmpEmployeeID," _
'        & " (CalcSalary2.dblTaxRate*CalcSalary1.SalaryTax1/100-CalcSalary2.dblDiscountTax)" _
'        & "-(CalcSalary3.dblTaxRate*CalcSalary1.SalaryTax2/100-CalcSalary3.dblDiscountTax)  AS dblTmpResult " _
'        & " FROM SalaryData,CalcSalary1,CalcSalary2,CalcSalary3 " _
'        & " WHERE SalaryData.lngEmployeeID=CalcSalary1.lngEmployeeID " _
'        & " AND SalaryData.lngEmployeeID=CalcSalary2.lngEmployeeID " _
'        & " AND SalaryData.lngEmployeeID=CalcSalary3.lngEmployeeID AND " & strWhere
'    Set recTmp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
'    If Not recTmp.EOF Then
'        recTmp.MoveLast
'        recTmp.MoveFirst
'        For i = 0 To recTmp.RowCount - 1
'            strSql = "UPDATE SalaryData SET SalaryData.dblNowTax = " & Format(IIf(IsNull(recTmp!dblTmpResult), 0, recTmp!dblTmpResult), "####0.00") _
'                & " WHERE SALARYDATA.lngEmployeeID =" & recTmp!lngTmpEmployeeID & " AND " & strWhere
'            gclsBase.BaseDB.Execute strSql
'            recTmp.MoveNext
'        Next
'    End If
    strSql = "UPDATE SalaryData SalaryDataTmp SET dblNowTax=" _
        & " (SELECT " _
        & " NVL(((CalcSalary2.dblTaxRate*CalcSalary1.SalaryTax1/100-CalcSalary2.dblDiscountTax)" _
        & "-(CalcSalary3.dblTaxRate*CalcSalary1.SalaryTax2/100-CalcSalary3.dblDiscountTax)) ,0) AS dblTmp " _
        & " FROM CalcSalary1,CalcSalary2,CalcSalary3 " _
        & " WHERE CalcSalary1.lngEmployeeID=SalaryDataTmp.lngEmployeeID " _
        & " AND CalcSalary2.lngEmployeeID=SalaryDataTmp.lngEmployeeID " _
        & " AND CalcSalary3.lngEmployeeID=SalaryDataTmp.lngEmployeeID )" _
        & " Where " & strWhere & "AND blnIsPersonTax=1"
    gclsBase.BaseDB.Execute strSql
'    '保证两位小数
'    strSql = "UPDATE Salarydata set Salarydata.dblNowTax=Ltrim(Rtrim(To_Char(Salarydata.dblNowTax,'999999999999999999990.00'))) Where " & strWhere
'    gclsBase.BaseDB.Execute strSql
    'qrfSalaryTax.Close
    'Set qrfSalaryTax = Nothing
    'gclsBase.BaseDB.QueryDefs.Delete "CalcIsNew"
    'gclsBase.BaseDB.QueryDefs.Delete "CalcSalary1"
    'gclsBase.BaseDB.QueryDefs.Delete "CalcSalary2"
    'gclsBase.BaseDB.QueryDefs.Delete "CalcSalary3"
    'gclsBase.BaseWorkSpace.CommitTrans
    Exit Sub
Errors:
    'If strErrorqrf <> "" Then
        'gclsBase.BaseDB.QueryDefs.Delete strErrorqrf
        'strErrorqrf = ""
    'End If
    Resume Next
End Sub
Private Sub CalcRowTax(ByVal strWhere As String, ByVal lngTaxID As Long)
    Dim strSql As String
    Dim dblTaxAmount As Double
    Dim dblTaxRate As Double
    Dim rec1 As rdoResultset
    Dim rec2 As rdoResultset
    Dim rec3 As rdoResultset
    Dim dblTmp As Double
    
    'On Error GoTo Errors
    '扣除起征金额后的上次应纳税所得额和扣税项目金额
    '当起征金额小于（上次应纳税所得额+扣税项目金额）时本次用于计算的金额为两者之差
    '否则本次用于计算的金额为零。SalaryTax1,本次金额；SalaryTax2，上次金额
'    strSql = "SELECT SalaryData.lngEmployeeID,IIF(SalaryData.dblLastTax+SalaryData.Sa" _
'        & lngTaxID & "<=SalaryData.dblDeductAmount,IIF(SalaryData.dblLastTax+" _
'        & "SalaryData.Sa" & lngTaxID & ">0,SalaryData.dblLastTax+" _
'        & "SalaryData.Sa" & lngTaxID & ",0),IIF(SalaryData.dblLastTax+SalaryData.Sa" _
'        & lngTaxID & ">SalaryData.dblStartAmount,SalaryData.dblLastTax+SalaryData.Sa" _
'        & lngTaxID & "-SalaryData.dblStartAmount,0)) AS SalaryTax1," _
'        & "IIF(SalaryData.dblLastTax<=SalaryData.dblDeductAmount," _
'        & "IIF(SalaryData.dblLastTax>0,SalaryData.dblLastTax,0),IIF(SalaryData.dblLastTax>" _
'        & "SalaryData.dblStartAmount,SalaryData.dblLastTax" _
'        & "-SalaryData.dblStartAmount,0)) AS SalaryTax2 FROM SalaryData  WHERE " _
'        & "blnIsPersonTax=True AND " & strWhere
'    Set rec1 = gclsBase.BaseDB.OpenRecordset(strSql, dbOpenSnapshot)
    strSql = "SELECT SalaryData.lngEmployeeID,DECODE(SIGN(SalaryData.dblLastTax+SalaryData.Sa" _
        & lngTaxID & "-SalaryData.dblDeductAmount),1,DECODE(SIGN(SalaryData.dblLastTax+SalaryData.Sa" _
        & lngTaxID & "-SalaryData.dblStartAmount),1,SalaryData.dblLastTax+SalaryData.Sa" _
        & lngTaxID & "-SalaryData.dblStartAmount,0),DECODE(SIGN(SalaryData.dblLastTax+" _
        & "SalaryData.Sa" & lngTaxID & "),1,SalaryData.dblLastTax+" _
        & "SalaryData.Sa" & lngTaxID & ",0)) AS SalaryTax1," _
        & "DECODE(SIGN(SalaryData.dblLastTax-SalaryData.dblDeductAmount),1," _
        & "DECODE(SIGN(SalaryData.dblLastTax-SalaryData.dblStartAmount),1,SalaryData.dblLastTax" _
        & "-SalaryData.dblStartAmount,0),DECODE(SIGN(SalaryData.dblLastTax),1,SalaryData.dblLastTax,0)) " _
        & "AS SalaryTax2 FROM SalaryData  WHERE " _
        & "blnIsPersonTax=1 AND " & strWhere
    Set rec1 = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If rec1.EOF Then
        Exit Sub
    End If
    '本次应纳税所得额的税率,速算扣除查询
'    strSql = "SELECT IIF(SalaryData.dblLastTax+SalaryData.Sa" _
'        & lngTaxID & "<= SalaryData.dblDeductAmount,SalaryData.dblStartTaxRate" _
'        & ",PersonTax.dblTaxRate) AS dblTaxRate,IIF(SalaryData.dblLastTax+SalaryData.Sa" _
'        & lngTaxID & "<= SalaryData.dblDeductAmount,0,PersonTax.dblDiscountTax)" _
'        & " AS dblDiscountTax FROM SalaryData,PersonTax  " _
'        & " WHERE PersonTax.dblAmount1<= " & rec1!SalaryTax1 _
'        & " AND IIF(PersonTax.dblAmount2=0,True," & rec1!SalaryTax1 & " <PersonTax.dblAmount2)" _
'        & " AND " & strWhere
'    Set rec2 = gclsBase.BaseDB.OpenRecordset(strSql, dbOpenSnapshot)
    strSql = "SELECT DECODE(SIGN(SalaryData.dblLastTax+SalaryData.Sa" _
        & lngTaxID & "- SalaryData.dblDeductAmount),1,PersonTax.dblTaxRate," _
        & "SalaryData.dblStartTaxRate) AS dblTaxRate,DECODE(SIGN(SalaryData.dblLastTax+SalaryData.Sa" _
        & lngTaxID & "- SalaryData.dblDeductAmount),1,PersonTax.dblDiscountTax,0)" _
        & " AS dblDiscountTax FROM SalaryData,PersonTax  " _
        & " WHERE PersonTax.dblAmount1<= " & rec1!SalaryTax1 & " AND " & strWhere _
        & " AND (PersonTax.dblAmount2=0 OR ( PersonTax.dblAmount2<>0 AND " & rec1!SalaryTax1 & " <PersonTax.dblAmount2))"
    Set rec2 = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If rec2.EOF Then
        Exit Sub
    End If
    '上次应纳税所得额的税率,速算扣除查询
'    strSql = "SELECT IIF(SalaryData.dblLastTax<=SalaryData.dblDeductAmount,SalaryData.dblStartTaxRate," _
'        & "PersonTax.dblTaxRate) AS dblTaxRate ,IIF(SalaryData.dblLastTax<=SalaryData.dblDeductAmount,0,PersonTax.dblDiscountTax)" _
'        & " AS dblDiscountTax FROM SalaryData,PersonTax " _
'        & " WHERE PersonTax.dblAmount1<= " & rec1!SalaryTax2 _
'        & " AND IIF(PersonTax.dblAmount2=0,True," & rec1!SalaryTax2 & " <PersonTax.dblAmount2)" _
'        & " AND " & strWhere
'    Set rec3 = gclsBase.BaseDB.OpenRecordset(strSql, dbOpenSnapshot)
    strSql = "SELECT DECODE(SIGN(SalaryData.dblLastTax-SalaryData.dblDeductAmount),1,PersonTax.dblTaxRate," _
        & "SalaryData.dblStartTaxRate) AS dblTaxRate ,DECODE(SIGN(SalaryData.dblLastTax-SalaryData.dblDeductAmount),1,PersonTax.dblDiscountTax,0)" _
        & " AS dblDiscountTax FROM SalaryData,PersonTax " _
        & " WHERE PersonTax.dblAmount1<= " & rec1!SalaryTax2 & " AND " & strWhere _
        & " AND (PersonTax.dblAmount2=0 OR ( PersonTax.dblAmount2<>0 AND " & rec1!SalaryTax2 & " <PersonTax.dblAmount2))"
    Set rec3 = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If rec3.EOF Then
        Exit Sub
    End If
    dblTmp = Format((rec2!dblTaxRate * rec1!SalaryTax1 / 100 - rec2!dblDiscountTax) - (rec3!dblTaxRate * rec1!SalaryTax2 / 100 - rec3!dblDiscountTax), "###0.00")
    '计算
    strSql = "UPDATE SalaryData SET SalaryData.dblNowTax=" & dblTmp _
        & " WHERE SalaryData.lngEmployeeID= " & rec1!lngEmployeeID & " And " & strWhere
    gclsBase.BaseDB.Execute strSql
    Exit Sub
Errors:
    Resume Next
End Sub
'计算扣零
Private Sub CalaZero(ByVal strWhere As String, ByVal lngZeroID As Long, ByVal dblDeductLevel As Double)
    Dim strSql As String
    'strSQL = "UPDATE SalaryData SET dblNowZero=IIf(((Sa" & lngZeroID & "*100) " _
            & " Mod 100*" & dblDeductLevel & ")/100 < 0 ,0 , ((Sa" & lngZeroID & "*100) " _
            & " Mod 100*" & dblDeductLevel & ")/100 ) WHERE " & strWhere
    strSql = "UPDATE SalaryData SET dblNowZero=DECODE(SIGN(MOD(Sa" & lngZeroID & "*100," _
            & "100*" & dblDeductLevel & ")/100),-1,0,(MOD(Sa" & lngZeroID & "*100," _
            & "100*" & dblDeductLevel & ")/100 )) WHERE " & strWhere
    gclsBase.BaseDB.Execute strSql
End Sub
'发放扣零
Private Sub PutZero(ByVal strWhere As String, ByVal lngDeductPutFieldID As Long)
    Dim strSql As String
    If lngDeductPutFieldID > 0 Then
        strSql = "UPDATE SalaryData SET Sa" & lngDeductPutFieldID & "=Sa" _
            & lngDeductPutFieldID & "+dblLastZero WHERE " & strWhere
        gclsBase.BaseDB.Execute strSql
    End If
End Sub
'根据关键字IN删除等号，如：部门名称='生产部'而'生产部'为非末级部门时，先在
'mclsDepoland_OnAccidenceParse中将'生产部'替换为：IN('一车间','二车间')。(其中'一车间',
''二车间'为'生产部'的下级明细部门)则公式变为：部门名称=IN('一车间','二车间')，
'多出一个等号。ChangIN的功能是将多出的等号删除。计算条件中包含"IN('"系统认为可能多出一个等号
'将紧靠前的"="删除
Public Sub ChangeIN(ByRef strCond As String)
    Dim strLeft As String
    Dim strRight As String
    Dim intStart As Integer
    Dim intLen As Integer
    Dim strFomular As String
    strFomular = strCond
    strCond = ""
    Do While InStr(strFomular, "IN('") > 0
        intStart = InStr(strFomular, "IN('")
        strLeft = Left(strFomular, intStart - 1)
        '紧挨等号
        If Right(Trim(strLeft), 1) = "=" Then
            '删除等号
            strLeft = Left(Trim(strLeft), Len(Trim(strLeft)) - 1) & " "
        End If
        '紧挨不等号
        If Right(Trim(strLeft), 2) = "<>" Then
            '删除等号
            strLeft = Left(Trim(strLeft), Len(Trim(strLeft)) - 2) & " NOT "
        End If
        strRight = Right(strFomular, Len(strFomular) - intStart + 1 - Len("IN('"))
        strFomular = strRight
        strCond = strCond & strLeft & "IN('"
    Loop
    strCond = strCond & strFomular
End Sub

'替换文本(在strFomular中将strOpr1替换成strOpr2)
'strOpr1被替换字符,strOpr2要替换字符，strFomular原来的字符串
'blnIsNotUcase 可选参数 TRUE（进行精确匹配），FALSE（转换为大写后进行匹配）
'返回替换后字符串
Public Function Change_Text(ByVal strOpr1 As String, ByVal strOpr2 As String, ByVal strFomular As String, Optional ByVal blnIsUsedUcase As Boolean = False) As String
    Dim strLeft As String
    Dim strRight As String
    Dim intStart As Integer
    Dim intLen As Integer