fixeddeccalc.bas

金算盘软件代码

                dblNetWorth, intUseAge, dblDecValue, intDecPeriod, intNowDecPeriod, intBeelinePeriod)
'        Else
'            DecAmount = CalcDecValue(strDepreciationMethod, dblAmount, dblNetWorth, intUseAge, _
'                dblInitDeprection, intDecPeriod, intNowDecPeriod, intBeelinePeriod)
'        End If
    Case "5"    '年数总和法
        '第一年已经计提的会计期间
        DecAmount = CalcDecValue(strDepreciationMethod, dblAmount, dblNetWorth, _
            intUseAge, dblInitDeprection, intDecPeriod, intNowDecPeriod)
    End Select
End Function
'四舍五入函数
Public Function FourLostFiveAdd(ByVal dblValue As Double, Optional bytNaturalCurDec As Byte) As Double
    If bytNaturalCurDec = 0 Then
        bytNaturalCurDec = gclsBase.NaturalCurDec
    End If
    FourLostFiveAdd = Int((dblValue + Val("0." & String(bytNaturalCurDec, "0") & "5")) _
        * Val("1" & String(bytNaturalCurDec, "0"))) / Val("1" _
        & String(bytNaturalCurDec, "0"))
End Function
'判断指定会计期间，指定卡片ID是否有变动记录
Private Function HaveAlterRecord(ByVal intYear As Integer, ByVal bytPeriod As Byte, ByVal lngFixedCardID As Long) As Boolean
    Dim strSql As String
    Dim rec As rdoResultset
    strSql = "SELECT lngFixedAlterID FROM FixedAlter WHERE intYear=" & intYear _
        & " AND bytPeriod=" & bytPeriod & " AND lngFixedCardID=" _
        & lngFixedCardID
    Set rec = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If rec.EOF Then
        HaveAlterRecord = False
    Else
        HaveAlterRecord = True
    End If
    rec.Close
    Set rec = Nothing
End Function
'写每次计提的折旧
Private Sub WriteBalancePeriodDeprection(ByVal lngFixedAlterID As Long, ByVal dblPeriodDeprection As Double, _
    ByVal lngFixedCardID As Long, ByVal blnIsAdd As Boolean)
    Dim strSql As String
    '是否为第一次写该变动记录对应的折旧
    If blnIsAdd Then
        strSql = "UPDATE FixedBalance,FixedAlter SET FixedBalance.dblPeriodDeprection=FixedBalance.dblPeriodDeprection+" & dblPeriodDeprection _
            & " WHERE FixedBalance.intYear=FixedAlter.intYear AND FixedBalance.bytPeriod=FixedAlter.bytPeriod AND " _
            & "FixedBalance.lngFixedCardID=" & lngFixedCardID & " AND FixedAlter.lngFixedCardID=" & lngFixedCardID & " AND FixedAlter.lngFixedAlterID=" & lngFixedAlterID
        gclsBase.BaseDB.Execute strSql
    Else
        strSql = "UPDATE FixedBalance,FixedAlter SET FixedBalance.dblPeriodDeprection=" & dblPeriodDeprection _
            & " WHERE FixedBalance.intYear=FixedAlter.intYear AND FixedBalance.bytPeriod=FixedAlter.bytPeriod AND " _
            & "FixedBalance.lngFixedCardID=" & lngFixedCardID & " AND FixedAlter.lngFixedCardID=" & lngFixedCardID _
            & " AND FixedAlter.lngFixedAlterID=" & lngFixedAlterID
        gclsBase.BaseDB.Execute strSql
    End If
End Sub
'查找最近的变动记录
Private Function Rec_FixedAlter(ByVal lngFixedCardID As Long, ByVal intYear As Integer, ByVal bytPeriod As Byte, _
    ByVal blnFirstDec As Boolean, ByRef recFixedAlter As rdoResultset) As Boolean
    Dim blnFind As Boolean
    Dim strSql As String
    Dim rec As rdoResultset
    Dim strAccountBeginDate As String
    blnFind = False
    '非第一次计算折旧取最近的变动记录
    If Not blnFirstDec Then
        '工作量法第一个月提折旧
        strSql = "SELECT MAX(FixedAlter.lngFixedAlterID) AS lngFixedAlterID FROM FixedAlter " _
            & "WHERE FixedAlter.lngFixedCardID=" & lngFixedCardID & " AND (CLng(FixedAlter.intYear)" _
            & "*100+FixedAlter.bytPeriod<" & CLng(intYear) * 100 + bytPeriod & " OR CLng(FixedAlter.intYear)" _
            & "*100+FixedAlter.bytPeriod<=" & CLng(intYear) * 100 + bytPeriod & " AND FixedAlter.strDepreciationMethod='3') " _
            & "And FixedAlter.strDeprectionFactor<>'0' "
        Set rec = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
        If Not rec.EOF Then
            If Not IsNull(rec!lngFixedAlterID) Then
                blnFind = True
                strSql = "SELECT FixedAlter.* FROM FixedAlter WHERE FixedAlter.lngFixedAlterID=" & rec!lngFixedAlterID
            End If
        End If
    Else
        strSql = "SELECT FixedAlter.* FROM FixedAlter,FixedCard WHERE " _
            & "FixedAlter.lngFixedCardID=" & lngFixedCardID & " AND FixedAlter.intYear=" & intYear _
            & " AND FixedAlter.bytPeriod=" & bytPeriod & " AND FixedCard.lngFixedCardID=FixedAlter.lngFixedCardID " _
            & "AND FixedCard.lngCreateFixedAlterID=FixedAlter.lngFixedAlterID AND CDate(FixedAlter.strDate)<CDate('" _
            & GetAccountBeginDate() & "')"
            blnFind = True
    End If
    If blnFind Then
        Set recFixedAlter = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    Else
        '返回一个无记录的记录集
        Set recFixedAlter = gclsBase.BaseDB.OpenResultset("SELECT * FROM FixedAlter WHERE 1=2", rdOpenStatic)
    End If
End Function
'计算折旧
Public Function FiexdDecDate() As Double
    '计算的卡片ID，开始计算的期间，开始计算的年，开始计算的起日期，结束计算的期间，
    '结束计算的年
    Dim strSql As String
    Dim rec As rdoResultset
    Dim datStartDate As Date               '当前会计期间的起日期
    Dim datEndDate As Date                 '当前会计期间的止日期
    Dim intFromYear As Integer             '本次计提折旧起年度
    Dim bytFromPeriod As Byte              '本次计提折旧起期间
    Dim intFirstYear As Integer            '第一个会计年度
    Dim bytFirstPeriod As Byte             '第一个会计期间
    Dim intNowYear As Integer              '当前会计年度
    Dim bytNowPeriod As Byte               '当前会计期间
    Dim strDepreciationMethod As String    '折旧方法
    Dim recFixedCard As rdoResultset          '可以计算折旧的固定资产记录集
    Dim recFixedAlter As rdoResultset         '用于计算折旧的变动记录集
    Dim intTotalPeriod As Integer          '本次计算会计期间总数
    Dim intEndYear As Integer              '本次计提折旧的止年
    Dim bytEndPeriod As Byte               '本次计提折旧的止期间
    Dim dblAmount As Double                '期初原值
    Dim intUseAge As Integer               '预计使用年限
    Dim dblNetWorth As Double              '预计净值
    Dim dblTotalWork As Double             '预计工作总量
    Dim intDecPeriod As Integer            '已提折旧期间数
    Dim strFixedState As String            '使用状态
    Dim datFromDate As Date                '开始计算日期
    Dim dblValue As Double                 '每次变动的折旧
    Dim dblDecValue As Double              '每个固定资产的折旧
    Dim dblDecTotalValue As Double         '折旧总计
    Dim blnCalcDec As Boolean              '计算折旧标志(当前会计期间为第一个会计期间时，若没有入帐前已经使用的记录则不计算折旧)
    Dim lngFixedID As Long                 '折旧ID
    Dim dblCalcDeprection As Double        '用于计算的折旧
    Dim blnDecRecord As Boolean            '已经参计提折旧的期间记录
    Dim blnNotDeprection As Boolean        '没有计算过折旧
    Dim intBeelinePeriod As Integer        '直线法用于计算的会计期间
    Dim lngAlterAddjustID As Long          '变动调整记录ID
    Dim datFirstStartDate As Date          '开始期间的起日期
    Dim datFirstEndDate As Date            '开始期间的止日期
    Dim strDepreciationType As String      '折旧类型
    Dim strFixedAlterDate As String        '固定资产变动日期
    Dim blnFirstDec As Boolean             '是否为第一个会计期间
    Dim blnFirst As Boolean                '是否为第一个会计期间
    Dim lngFixedAlterBakID As Long         '备份变动记录
    Dim dblCalcDeprectionBak As Double     '用份变于计算的折旧
    Dim intLoopYear As Integer
    Dim bytLoopPeriod As Byte
    Dim intRealCalcPeriod As Integer
    Dim strDeprectionFactor As String
    intYearPeriod = PeriodsOfYear()
    '当前会计期间
    intNowYear = gclsBase.AccountYear
    bytNowPeriod = gclsBase.Period
    '查找帐套启用期间（若所有期间均未提折旧则以第一个会计期间起开始计算折旧）
    strSql = "SELECT AccountPeriod.intYear,AccountPeriod.strStartDate,AccountPeriod.strEndDate, " _
        & "AccountPeriod.bytPeriod,AccountPeriod.strStartDate FROM Business INNER JOIN AccountPeriod ON " _
        & "(Business.strStartDate>=AccountPeriod.strStartDate) AND (Business.strStartDate<=AccountPeriod.strEndDate)"
    Set rec = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If Not rec.EOF Then
        intFirstYear = rec!intYear
        bytFirstPeriod = rec!bytPeriod
        datFirstEndDate = CDate(rec!strEndDate)
        datFirstStartDate = CDate(rec!strStartDate)
        datFromDate = CDate(rec!strStartDate)
        intFromYear = intFirstYear
        bytFromPeriod = bytFirstPeriod
    Else
        Exit Function
    End If
    '判断是否为入帐前已经使用
    If intFirstYear = intFromYear And bytFirstPeriod = bytFromPeriod Then
        blnFirst = True
    Else
        blnFirst = False
    End If
    '将凭证中凭证来源为折旧的最大会计期间的凭证所对应的会计期间起时间作为固定资产折旧的
    '开始计算日期，期间，年
    strSql = "SELECT Max(Cdate(AccountPeriod.strStartDate)) AS FromDate FROM Voucher INNER JOIN " _
        & "AccountPeriod ON (Voucher.intYear = AccountPeriod.intYear) AND (Voucher.bytPeriod" _
        & " = AccountPeriod.bytPeriod) WHERE  Voucher.lngVoucherSourceID=15 AND Voucher.blnIsVoid=False"
    Set rec = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If Not rec.EOF And Not IsNull(rec!fromdate) Then
        '开始计算起期间、年、期间
        datFromDate = rec!fromdate
        intFromYear = gclsBase.FYearOfDate(datFromDate)
        bytFromPeriod = gclsBase.PeriodOfDate(datFromDate)
        If bytFromPeriod < intYearPeriod Then
            bytFromPeriod = bytFromPeriod + 1
        Else
            intFromYear = intFromYear + 1
            bytFromPeriod = 1
        End If
        blnFirst = False
        '计算过折旧
        blnNotDeprection = False
    Else
        '没有计算过折旧
        blnNotDeprection = True
    End If
    '无会计期间可以计算折旧
    If CLng(intFromYear) * 100 + bytFromPeriod > CLng(intNowYear) * 100 + bytNowPeriod Then
        Exit Function
    End If
    '轻除所有大于或等于开始计算折旧的期间的余额表
    strSql = "UPDATE FixedBalance SET dblDeprection=0,intPeriod=0 WHERE CLng(intYear)*100+bytPeriod>" _
        & (CLng(intFromYear) * 100 + bytFromPeriod)
    gclsBase.BaseDB.Execute strSql
    strSql = "UPDATE FixedBalance SET dblPeriodDeprection=0"
    gclsBase.BaseDB.Execute strSql
    '剔除永远不提折旧和作废的卡片以及本次计算以后的卡片后的所有固定资产卡片记录作为外部循环