fixeddeccalc.bas

来自「金算盘软件代码」· BAS 代码 · 共 604 行 · 第 1/3 页

    strSql = "SELECT FixedCard.*,FixedAlter_1.blnIsVoid,FixedType.strDepreciationType," _
        & "FixedAlter_1.strDepreciationMethod,FixedAlter.strDate FROM ((FixedCard INNER JOIN FixedAlter ON " _
        & "(FixedCard.lngFixedCardID = FixedAlter.lngFixedCardID) AND (FixedCard.lngCreateFixedAlterID" _
        & " = FixedAlter.lngFixedAlterID)) INNER JOIN FixedAlter AS FixedAlter_1 ON (" _
        & "FixedAlter_1.lngFixedAlterID = FixedCard.lngRecentFixedAlterID) AND (FixedCard.lngFixedCardID " _
        & "= FixedAlter_1.lngFixedCardID)) INNER JOIN FixedType ON FixedType.lngFixedTypeID=" _
        & "FixedCard.lngFixedTypeID Where FixedAlter.blnIsVoid = False And FixedType.strDepreciationType <> 2 " _
        & "AND FixedAlter.lngFixedCardID NOT IN(SELECT FixedAlter.lngFixedCardID FROM FixedAlter, FixedCard " _
        & "WHERE FixedCard.lngRecentFixedAlterID = FixedAlter.lngFixedAlterID AND FixedAlter.lngFixedCardID " _
        & "= FixedCard.lngFixedCardID AND FixedAlter.bytAlterType=2 AND Clng(FixedAlter.intYear)*100+" _
        & "FixedAlter.bytPeriod<" & CLng(gclsBase.AccountYear) * 100 + gclsBase.Period & ")"
    Set recFixedCard = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    With recFixedCard
        If .EOF Then
            Exit Function
        End If
        .MoveLast
        .MoveFirst
        '按固定资产卡片做外部循环
        Do While Not .EOF
            '初始化本次计算总的期间
            intTotalPeriod = 0
            '若为正常计提折旧
            strDepreciationType = !strDepreciationType
            dblCalcDeprection = 0
            lngAlterAddjustID = 0
            '按变动记录做内部循环
            dblDecValue = 0
            lngFixedID = !lngFixedCardID
            blnFirstDec = False
            If blnFirst Then
                If !strDepreciationMethod = "3" Then
                    '工作量法第一个月提折旧
                    blnFirstDec = True
                Else
                    strSql = "SELECT strDate FROM FixedAlter WHERE lngFixedCardID=" & lngFixedID _
                        & " AND lngFixedAlterID=" & !lngCreateFixedAlterID & " AND CDate(strDate)<CDate('" _
                        & GetAccountBeginDate() & "')"
                    Set rec = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
                    If Not rec.EOF Then
                        blnFirstDec = True
                    End If
                End If
            End If
            blnDecRecord = True
            blnCalcDec = False
            intLoopYear = intFromYear
            bytLoopPeriod = bytFromPeriod
            '查找期初的已提折旧期间数和累计折旧
            strSql = "SELECT FixedBalance.* FROM FixedBalance WHERE CLng(FixedBalance.intYear)*100+" _
                & "FixedBalance.bytPeriod<" & CLng(intFromYear) * 100 + bytFromPeriod + IIf(blnFirst, 1, 0) _
                & " AND FixedBalance.lngFixedCardID=" & lngFixedID & " ORDER BY CLng(FixedBalance.intYear)*" _
                & "100+FixedBalance.bytPeriod ASC"
            Set rec = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
            '***唐吉禹修改-1999-3-2  Begin
            If rec.EOF Then
                strSql = "SELECT FixedBalance.* FROM FixedBalance WHERE CLng(FixedBalance.intYear)" _
                    & "*100+FixedBalance.bytPeriod=(SELECT Min(CLng(FixedBalance.intYear)*100+" _
                    & "FixedBalance.bytPeriod) FROM FixedBalance WHERE FixedBalance.lngFixedCardID=" _
                    & lngFixedID & ") AND FixedBalance.lngFixedCardID=" & lngFixedID _
                    & " ORDER BY CLng(FixedBalance.intYear)*" & "100+FixedBalance.bytPeriod DESC"
                Set rec = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
            End If
            '***唐吉禹修改-1999-3-2  End
            If Not rec.EOF Then
                rec.MoveLast
                If intLoopYear = intFirstYear And bytLoopPeriod = bytFirstPeriod Then
                    intDecPeriod = rec!intCalcPeriod
                    dblCalcDeprection = rec!dblCalcDeprection
                Else
                    intDecPeriod = rec!intCalcPeriod + rec!intPeriod
                    If rec!dblInitAmount > 0 Then
                        dblCalcDeprection = rec!dblCalcDeprection + rec!dblAlterDeprection + rec!dblDeprection
                    Else
                        dblCalcDeprection = rec!dblCalcDeprection + rec!dblDeprection
                    End If
                End If
                dblCalcDeprectionBak = dblCalcDeprection
            End If
            '第一次提折旧且没有期初数据
            If blnFirst And Not blnFirstDec Then
                If bytFromPeriod < intYearPeriod Then
                    bytLoopPeriod = bytFromPeriod + 1
                Else
                    intLoopYear = intFromYear + 1
                    bytLoopPeriod = 1
                End If
            End If
            '初始化备份变动记录
            lngFixedAlterBakID = 0
            intRealCalcPeriod = 0
            Do While CLng(intLoopYear) * 100 + bytLoopPeriod <= CLng(intNowYear) * 100 + bytNowPeriod
                '工作量法第一个月提折旧
                If !strDepreciationMethod = "3" Then blnFirstDec = False
                Call Rec_FixedAlter(lngFixedID, intLoopYear, bytLoopPeriod, (intFirstYear = intLoopYear _
                    And bytFirstPeriod = bytLoopPeriod And blnFirstDec), recFixedAlter)
                blnFirstDec = False
                dblValue = 0
                If Not recFixedAlter.EOF Then
                    With recFixedAlter
                        blnCalcDec = True
                        '根据用于计算的变动记录对应的余额表取出预计使用年限和原值以及用于计算的直线法的会计期间
                        strSql = "SELECT  FixedBalance.intCalcPeriod, FixedBalance.intCalcUseAge," _
                            & "FixedBalance.intBeelinePeriod,FixedBalance.dblCalcAmount,FixedBalance.intPeriod, " _
                            & "FixedBalance.dblCalcDeprection,FixedBalance.dblInitDeprection FROM FixedBalance " _
                            & "INNER JOIN FixedAlter ON (FixedAlter.intYear=FixedBalance.intYear) AND " _
                            & "(FixedAlter.bytPeriod=FixedBalance.bytPeriod) WHERE FixedBalance.lngFixedCardID=" _
                            & lngFixedID & " AND FixedAlter.lngFixedAlterID=" & !lngFixedAlterID
                        Set rec = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
                        If rec.EOF Then Exit Function
                        intUseAge = rec!intCalcUseAge
                        dblAmount = rec!dblCalcAmount
                        intBeelinePeriod = rec!intBeelinePeriod
                        '根据变动表取折旧计算因子，预计净残值，预计工作量
                        strDeprectionFactor = !strDeprectionFactor
                        dblTotalWork = !dblTotalWork
                        dblNetWorth = !dblNetWorth
                        strDepreciationMethod = !strDepreciationMethod
                        If strDeprectionFactor = 2 Then                      '按剩余期间和净值计算折旧
                            '将累计折旧和已提折旧期间数均置为0
'                            dblCalcDeprection = 0
'                            intDecPeriod = 0
                        End If
                        '计算的起期间
                        strFixedState = !strFixedState
                        strFixedAlterDate = !strDate
                        '判断能否计提折旧(若折旧类型为永远计提折旧，或使用中或租出)
                        If IIf(strDepreciationType = 3, True, (strFixedState = "1" Or strFixedState = "4")) Then
                            '若循环结束则取当前的会计期间和会计年度作为计算的止期间和止年度
                            '工作量法
                            If strDepreciationMethod = "3" Then
                                '计算工作量和折旧
                                 dblValue = CDbl(CalcWork(intLoopYear, bytLoopPeriod, lngFixedID)) _
                                    * (dblAmount - dblNetWorth) / dblTotalWork
                            Else
                                '计算折旧
                                dblValue = DecAmount(intDecPeriod, strDepreciationMethod, dblAmount, _
                                    dblNetWorth, intUseAge, dblCalcDeprection, blnFirstDec, lngFixedID, intBeelinePeriod)
                            End If
                            '若本次计提的折旧大于当前净值则将本次计提的折旧置为当前净值
                            If dblValue > dblAmount - dblNetWorth - dblCalcDeprection Then
                                dblValue = dblAmount - dblNetWorth - dblCalcDeprection
                                If dblValue < 0 Then
                                    dblValue = 0
                                End If
                                '退出循环
                                intLoopYear = intNowYear
                                bytLoopPeriod = bytNowPeriod
                            End If
                            '四舍五入
                            dblValue = FourLostFiveAdd(dblValue)
                            intTotalPeriod = intTotalPeriod + 1
                            dblDecValue = dblDecValue + dblValue
                            WriteBalancePeriodDeprection !lngFixedAlterID, dblValue, lngFixedID, lngFixedAlterBakID = CLng(!intYear) * 100 + !bytPeriod
                            '调整已提折旧期间数和累计折旧
                            dblCalcDeprection = dblCalcDeprection + dblValue
                            intDecPeriod = intDecPeriod + 1
                        End If
                        lngFixedAlterBakID = CLng(!intYear) * 100 + !bytPeriod
                    End With
                End If
                If dblValue <> 0 Then
                    intRealCalcPeriod = intRealCalcPeriod + 1
                End If
                If bytLoopPeriod < intYearPeriod Then
                    bytLoopPeriod = bytLoopPeriod + 1
                Else
                    intLoopYear = intLoopYear + 1
                    bytLoopPeriod = 1
                End If
            Loop
'            If lngAlterAddjustID > 0 Then
'                UpdateAfterFixedAlter lngAlterAddjustID, True
'            End If
            '写已提折旧期间
            If blnCalcDec Then
                '写本期计提折旧
                WriteBlance !lngFixedCardID, intNowYear, bytNowPeriod, dblDecValue, intRealCalcPeriod, dblCalcDeprectionBak
            End If
            dblCalcDeprection = 0
            dblDecTotalValue = dblDecTotalValue + dblDecValue
            .MoveNext
        Loop
    End With
    Call UpdateMonthFixedAlter(intNowYear, bytNowPeriod)
    FiexdDecDate = dblDecTotalValue
End Function
'
Public Function GetAccountBeginDate() As String
    Dim strSql As String
    Dim rec As rdoResultset
    strSql = "SELECT strStartDate FROM Business "
    Set rec = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If Not rec.EOF Then
        GetAccountBeginDate = Format(rec!strStartDate, "yyyy-mm-dd")
    End If
End Function