salary.bas

金算盘软件代码

    Dim strTmp As String
    If strOpr1 = strOpr2 Then
        Change_Text = strFomular
        Exit Function
    End If
    If Trim(strFomular) = "" Then
        Change_Text = strFomular
        Exit Function
    End If
    strTmp = strFomular
    strFomular = ""
    If Not blnIsUsedUcase Then
        Do While InStr(strTmp, strOpr1) > 0
            intStart = InStr(strTmp, strOpr1)
            strLeft = Left(strTmp, intStart - 1)
            strRight = Right(strTmp, Len(strTmp) - intStart + 1 - Len(strOpr1))
            strTmp = strRight
            strFomular = strFomular + strLeft + strOpr2
        Loop
    Else
        Do While InStr(UCase(strTmp), UCase(strOpr1)) > 0
            intStart = InStr(UCase(strTmp), UCase(strOpr1))
            strLeft = Left(strTmp, intStart - 1)
            strRight = Right(strTmp, Len(strTmp) - intStart + 1 - Len(strOpr1))
            strTmp = strRight
            strFomular = strFomular + strLeft + strOpr2
        Loop
    End If
    strFomular = strFomular + strTmp
    Change_Text = strFomular
End Function
'计算历史数据
Public Sub CalcOldData(ByVal lngSalaryListID As Long, ByVal blnEdit As Boolean)
    '工资表ID，是否录入（进程条是否刷新）
    Dim strSql As String
    Dim recRecordset As rdoResultset
    Dim strWhere As String
    Dim blnIsZero As Boolean
    Dim i As Long
    Dim bytNowPeriod As Byte
    Dim intNowYear As Integer
    Dim bytPeriod As Byte
    Dim intYear As Integer
    Dim blnIsMonthDuduct As Boolean
    Dim lngSalaryListID2 As Long
    Dim lngTaxFieldID As Long
    Dim rec As rdoResultset
    Dim rec1 As rdoResultset
    Dim recTmp As rdoResultset
    Dim blnIsrefsh As Boolean
    
    '取本次的会计期间、会计年度
    strSql = "SELECT lngSalaryListID,dblDeductLevel,blnIsMonthDuduct,lngDeductFieldID,strDate," _
        & "blnIsTax,lngTaxFieldID FROM SalaryList WHERE lngSalaryListID=" & lngSalaryListID
    Set recRecordset = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If recRecordset.EOF Then
        Exit Sub
    End If
    blnIsMonthDuduct = recRecordset!blnIsMonthDuduct
    '取得本次工资表所在年和所在月
    bytPeriod = Month(recRecordset!strDate)
    intYear = Year(recRecordset!strDate)
    lngTaxFieldID = recRecordset!lngTaxFieldID
    '大于本次的历史工资表
    'strSQL = "SELECT SalaryList.lngSalaryListID,SalaryList.dblDeductLevel,SalaryList.blnIsMonthDuduct" _
        & ",SalaryList.lngDeductFieldID,SalaryList.strDate,SalaryList.blnIsTax,SalaryList.lngTaxFieldID" _
        & ",SalaryList.lngDeductPutFieldID FROM SalaryList INNER JOIN AccountPeriod ON (SalaryList.strDate " _
        & " <= AccountPeriod.strEndDate) AND (SalaryList.strDate >= AccountPeriod.strStartDate) " _
        & " Where (Clng(Year(SalaryList.strDate))*100+Clng(Month(SalaryList.strDate)))*10000 +SalaryList.lngSalaryListID >= " _
        & (CLng(intyear) * 100 + CLng(bytPeriod)) * 10000 + lngSalaryListID
    strSql = "SELECT SalaryList.lngSalaryListID,SalaryList.dblDeductLevel,SalaryList.blnIsMonthDuduct," _
        & "SalaryList.lngDeductFieldID,SalaryList.strDate,SalaryList.blnIsTax,SalaryList.lngTaxFieldID," _
        & "SalaryList.lngDeductPutFieldID FROM SalaryList,AccountPeriod " _
        & " WHERE (SalaryList.strDate<= AccountPeriod.strEndDate) " _
        & " AND (SalaryList.strDate >= AccountPeriod.strStartDate) " _
        & " AND (TO_NUMBER(TO_CHAR(TO_DATE(SalaryList.strDate,'RRRR-MM-DD'),'YYYY'))*100+ " _
        & " TO_NUMBER(TO_CHAR(TO_DATE(SalaryList.strDate,'RRRR-MM-DD'),'MM')))*10000 " _
        & " +SalaryList.lngSalaryListID >= " _
        & (CLng(intYear) * 100 + CLng(bytPeriod)) * 10000 + lngSalaryListID
    Set recRecordset = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If recRecordset.EOF Then
        Exit Sub
    Else
        On Error GoTo Errors1
        If blnEdit Then
            frmSalaryEdit.prgBar.top = frmSalaryEdit.Height - 780
            frmSalaryEdit.prgBar.Left = frmSalaryEdit.width - frmSalaryEdit.prgBar.width - 150
            frmSalaryEdit.prgBar.Value = 0
            frmSalaryEdit.prgBar.Visible = True
        End If
        recRecordset.MoveLast
        recRecordset.MoveFirst
        With recRecordset
            i = 1
            Do
                If blnEdit Then
                    frmSalaryEdit.prgBar.Value = 80 * i / recRecordset.RowCount
                End If
                bytNowPeriod = Month(recRecordset!strDate)
                intNowYear = Year(recRecordset!strDate)
                lngSalaryListID2 = recRecordset!lngSalaryListID
                '生成本次发放的记录集
                strSql = "SELECT Salary.lngEmployeeID,Salary.dblLastZero,Salary.dblLastTax FROM " _
                    & "Salary WHERE Salary.lngSalaryListID=" & lngSalaryListID2
                Set rec = gclsBase.BaseDB.OpenResultset(strSql, rdOpenDynamic, rdConcurRowVer, 64)
                '更新上次扣零（根据本次发放的职员记录集查找本次以前的最近次的数据）
                If Not rec.EOF Then
                    rec.MoveLast
                    rec.MoveFirst
                End If
                Do While Not rec.EOF
                    'rec.Edit
                    '查找最近的工资发放记录(*10000是为了排序时先按期间排序再按照工资表ID排序)
                    'strSQL = "SELECT IIF(SalaryList.blnIsMonthDuduct=True" _
                        & ",Salary.dblNowZero, Salary.dblNowZero+Salary.dblLastZero) AS Zero FROM" _
                        & " (Salary INNER JOIN SalaryList ON Salary.lngSalaryListID = " _
                        & "SalaryList.lngSalaryListID) INNER JOIN AccountPeriod ON (SalaryList.strDate" _
                        & " <= AccountPeriod.strEndDate) AND (SalaryList.strDate >= " _
                        & "AccountPeriod.strStartDate)  WHERE Salary.lngEmployeeID=" & Rec!lngEmployeeID _
                        & " AND (Clng(Year(SalaryList.strDate))*100+Clng(Month(SalaryList.strDate)))*10000" _
                        & "+SalaryList.lngSalaryListID<" & ((CLng(intNowYear) * 100 + CLng(bytNowPeriod)) * 10000 + _
                        lngSalaryListID2) & " ORDER BY ((Clng(Year(SalaryList.strDate))*100+Clng(Month(SalaryList.strDate)))" _
                        & "*10000+SalaryList.lngSalaryListID) DESC "
                    strSql = "SELECT DECODE(SalaryList.blnIsMonthDuduct,1," _
                        & "Salary.dblNowZero, Salary.dblNowZero+Salary.dblLastZero) AS Zero" _
                        & " FROM Salary,SalaryList,AccountPeriod " _
                        & " WHERE Salary.lngSalaryListID =SalaryList.lngSalaryListID " _
                        & " AND (SalaryList.strDate<= AccountPeriod.strEndDate) " _
                        & " AND (SalaryList.strDate >= AccountPeriod.strStartDate) " _
                        & " AND  Salary.lngEmployeeID=" & rec!lngEmployeeID _
                        & " AND (TO_NUMBER(TO_CHAR(TO_DATE(SalaryList.strDate,'RRRR-MM-DD'),'YYYY'))*100+ " _
                        & " TO_NUMBER(TO_CHAR(TO_DATE(SalaryList.strDate,'RRRR-MM-DD'),'MM')))*10000" _
                        & " +SalaryList.lngSalaryListID<" & ((CLng(intNowYear) * 100 + CLng(bytNowPeriod)) * 10000 + lngSalaryListID2) _
                        & " ORDER BY ((TO_NUMBER(TO_CHAR(TO_DATE(SalaryList.strDate,'RRRR-MM-DD'),'YYYY'))*100+ " _
                        & " TO_NUMBER(TO_CHAR(TO_DATE(SalaryList.strDate,'RRRR-MM-DD'),'MM')))" _
                        & " *10000+SalaryList.lngSalaryListID)  DESC "
                    Set rec1 = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
                    strSql = "UPDATE Salary Set dblLastZero = " & IIf(rec1.EOF, 0, rec1!Zero) _
                        & " WHERE Salary.lngSalaryListID=" & lngSalaryListID2 _
                        & " AND Salary.lngEmployeeID=" & rec!lngEmployeeID
                    gclsBase.BaseDB.Execute strSql
'                    rec.Edit
'                    If Not rec1.EOF Then
'                        rec1.MoveFirst
'                        rec!dblLastZero = rec1!Zero
'                    Else
'                        rec!dblLastZero = 0
'                    End If
'                    rec.Update
                    rec.MoveNext
                Loop
                '应纳税所得额（等于本月小于本次的所有代扣税额的合计）
                strSql = ""
                '本次工资表和历史工资表如果非同一个月(扣税按月进行计算)
                If intNowYear <> intYear Or bytNowPeriod <> bytPeriod Then
                    intYear = intNowYear
                    bytPeriod = bytNowPeriod
                    strSql = "UPDATE Salary SET Salary.dblLastTax=0 WHERE Salary.lngSalaryListID=" _
                        & lngSalaryListID2
                    gclsBase.BaseDB.Execute strSql
                Else
                    If lngTaxFieldID > 0 Then
                        '先将本次的上次应纳税所得额置为0
                        strSql = "UPDATE Salary SET dblLastTax=0 WHERE lngSalaryListID=" & lngSalaryListID2
                        gclsBase.BaseDB.Execute strSql
                        '当前月所有小于本次发放的工资目录表
                         'strSQL = "SELECT SalaryList.lngSalaryListID,SalaryList.lngTaxFieldID ," _
                            & " SalaryList.strDate FROM SalaryList INNER JOIN " _
                            & "AccountPeriod ON (SalaryList.strDate <= AccountPeriod.strEndDate) " _
                            & "AND (SalaryList.strDate >= AccountPeriod.strStartDate) " _
                            & " WHERE Year(SalaryList.strDate ) = " & intNowYear _
                            & " AND Month(SalaryList.strDate ) = " & bytNowPeriod _
                            & " AND SalaryList.lngSalaryListID<" & lngSalaryListID2
                        strSql = "SELECT SalaryList.lngSalaryListID,SalaryList.lngTaxFieldID ," _
                            & " SalaryList.strDate FROM SalaryList,AccountPeriod " _
                            & " WHERE (SalaryList.strDate <= AccountPeriod.strEndDate) " _
                            & " AND (SalaryList.strDate >= AccountPeriod.strStartDate) " _
                            & " AND TO_CHAR(TO_DATE(SalaryList.strDate,'RRRR-MM-DD'),'YYYY') = " & intNowYear _
                            & " AND TO_CHAR(TO_DATE(SalaryList.strDate,'RRRR-MM-DD'),'MM') = " & bytNowPeriod _
                            & " AND SalaryList.lngSalaryListID<" & lngSalaryListID2
                        Set rec = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
                        If Not rec.EOF Then
                            rec.MoveLast
                            rec.MoveFirst
                        End If
                        Do While Not rec.EOF
                            If rec!lngTaxFieldID > 0 Then
                                'strSql = "UPDATE Salary AS Tab1,Salary AS Tab2 SET Tab2.dblLastTax=Tab2.dblLastTax" _
                                    & "+Tab1.Sa" & rec!lngTaxFieldID & " WHERE Tab1.lngSalaryListID=" & rec!lngSalaryListID _
                                    & " AND Tab2.lngSalaryListID=" & lngSalaryListID2 & " AND Tab1.lngEmployeeID=" _
                                    & "Tab2.lngEmployeeID"
                                'gclsBase.BaseDB.Execute strSql
                                strSql = "Select Tab1.lngEmployeeID,Tab2.dblLastTax+Tab1.Sa" & rec!lngTaxFieldID _
                                    & " As LastTax From Salary Tab1,Salary Tab2 WHERE Tab1.lngSalaryListID=" & rec!lngSalaryListID _
                                    & " AND Tab2.lngSalaryListID=" & lngSalaryListID2 & " AND Tab1.lngEmployeeID=" _
                                    & "Tab2.lngEmployeeID"
                                Set recTmp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
                                If Not recTmp.EOF Then
                                    recTmp.MoveFirst
                                    Do While Not recTmp.EOF
                                        strSql = "UPDATE Salary SET Salary.dblLastTax= " & IIf(IsNull(recTmp!LastTax), 0, recTmp!LastTax) _
                                            & " WHERE Salary.lngSalaryListID=" & lngSalaryListID2 & " AND Salary.lngEmployeeID=" _
                                            & recTmp!lngEmployeeID
                                        gclsBase.BaseDB.Execute strSql
                                        recTmp.MoveNext
                                    Loop
                                End If
                                recTmp.Close
                                Set recTmp = Nothing
                            End If
                            rec.MoveNext
                        Loop
                    End If
                End If

                lngTaxFieldID = recRecordset!lngTaxFieldID
                If !dblDeductLevel > 0 Then
                    blnIsZero = True
                Else
                    blnIsZero = False
                End If
                strWhere = "lngSalaryListID=" & !lngSalaryListID
                If Salary.SalaryCalc(strWhere, !lngSalaryListID, 0, blnIsZero, !blnIsTax, _
                    !lngDeductFieldID, !lngTaxFieldID, !dblDeductLevel, !lngDeductPutFieldID, blnIsrefsh) Then
                    If blnEdit Then
                        frmSalaryEdit.prgBar.Value = 100
                    End If
                    Exit Sub
                End If
                .MoveNext
                i = i + 1
            Loop Until .EOF
            If blnEdit Then
                frmSalaryEdit.prgBar.Va