showalterinfo.bas

金算盘软件代码

                Do While intCalcPeriod >= intYearPreiod
                    intCalcPeriod = intCalcPeriod - intYearPreiod
                    intCalcUseAge = intCalcUseAge - 1
                Loop
                '判断当前会计期间本固定资产是否能够计算折旧
'                Dim datStartDate As Date
'                If Not recPreFixedBalance.EOF Then
'                    Call gclsBase.DateOfPeriod(gclsBase.AccountYear, gclsBase.Period, datStartDate)
'                    '查找能够计算折旧的记录
'                    strSql = "SELECT FixedAlter.*,FixedCard.lngCreateFixedAlterID FROM (FixedAlter INNER " _
'                        & "JOIN FixedCard ON FixedCard.lngFixedCardID=FixedAlter.lngFixedCardID) " _
'                        & "INNER JOIN FixedType ON FixedType.lngFixedTypeID=FixedCard.lngFixedTypeID WHERE " _
'                        & "CDATE(FixedAlter.strDate)<#" & Format(datStartDate, "yyyy-mm-dd") & "# AND FixedAlter.strDeprectionFactor<>'0'" _
'                        & " AND FixedAlter.strDepreciationMethod<>'1' AND IIF(FixedAlter.strFixedState" _
'                        & " IN ('1','4'),True,FixedType.strDepreciationType=3) ORDER BY FixedAlter.strDate DESC"
'                    Set rec = gclsBase.BaseDB.OpenResultset(strsql, rdOpenstatic)
'                    If Not rec.EOF Then
'                        rec.MoveFirst
'                        '将已折旧期间加1。
'                        strSql = "SELECT AccountPeriod.intYear, AccountPeriod.bytPeriod FROM Business INNER " _
'                            & "JOIN AccountPeriod ON (Business.strStartDate <= AccountPeriod.strEndDate) AND " _
'                            & "(Business.strStartDate >= AccountPeriod.strStartDate)"
'                        Set rec = gclsBase.BaseDB.OpenResultset(strsql, rdOpenstatic)
'                        If Not rec.EOF Then
'                            If recPreFixedBalance!intYear <> rec!intYear And recPreFixedBalance!bytPeriod <> rec!bytPeriod Then
'                                intCalcPeriod = intCalcPeriod
'                                If intBeelinePeriod > 0 Then
'
'                                    intBeelinePeriod = intBeelinePeriod - 1 'recPreFixedBalance!intPeriod
'
'                                End If
'                            Else
'                                If blnInit Then
'                                    intBeelinePeriod = intBeelinePeriod - 1
'                                Else
'                                    intBeelinePeriod = intBeelinePeriod
'                                    intCalcPeriod = intCalcPeriod - recPreFixedBalance!intPeriod  '因为下次计算时要加上该数据
'                                End If
'                            End If
'                        Else
'                            intBeelinePeriod = intBeelinePeriod + recPreFixedBalance!intPeriod - 1
'                            intCalcPeriod = intCalcPeriod
'                        End If
'                        rec.Close
'                        Set rec = Nothing
'                    Else
'                        If blnFirstMonthAlter Then
'                            intBeelinePeriod = intBeelinePeriod '+ recPreFixedBalance!intPeriod
'                            intCalcPeriod = intCalcPeriod - recPreFixedBalance!intPeriod
'                        Else
'                            intBeelinePeriod = intBeelinePeriod '+ recPreFixedBalance!intPeriod
'                            intCalcPeriod = intCalcPeriod - recPreFixedBalance!intPeriod
'                        End If
'                    End If
'                End If
            End With
            '使本期的期初折旧加上计算折旧调整数之和为0
            dblCalcDeprection = 0
            If recFixedAlter!strDepreciationMethod = "2" Then
                intCalcPeriod = 0
            End If
        End Select
        recPreFixedBalance.Close
        Set recPreFixedBalance = Nothing
        If recFixedAlter!bytAlterType = 2 Then
            dblCalcAmount = -dblInitAmount
            dblCalcDeprection = -dblInitDeprection
        End If
        '更新余额表
        strSql = "SELECT * FROM FixedBalance WHERE lngFixedCardID=" & recFixedAlter!lngFixedCardID _
            & " AND intYear=" & intYear & " AND bytPeriod=" & intPeriod
        Set recFixedBalance = gclsBase.BaseDB.OpenResultset(strSql, rdOpenDynamic, rdConcurValues)
        With recFixedBalance
            If .EOF Then
                .AddNew
                !intYear = intYear
                !bytPeriod = intPeriod
                !lngFixedCardID = recFixedAlter!lngFixedCardID
            Else
                .Edit
            End If
            !dblInitAmount = dblInitAmount
            !dblInitDeprection = dblInitDeprection
            !dblInitAccumaWork = dblInitAccumaWork
            If dblAmount >= 0 Then
                !dblDebitAmount = dblAmount
                !dblCreditAmount = 0
            Else
                !dblDebitAmount = 0
                !dblCreditAmount = Abs(dblAmount)
            End If
            !dblAlterDeprection = dblDeprection
            If Not (recFixedAlter!strDeprectionFactor = "0" And blnFirstMonthAlter) Then
                !intCalcPeriod = intCalcPeriod
                !intCalcUseAge = intCalcUseAge
                If recFixedAlter!strDeprectionFactor = "2" Then
                    If blnInit Then
                        !dblCalcAmount = dblInitAmount + dblAmount - dblInitDeprection
                    Else
                        !dblCalcAmount = dblInitAmount + dblAmount - dblInitDeprection - dblDeprection - !dblDeprection
                    End If
                Else
                    !dblCalcAmount = dblCalcAmount
                End If
                If recFixedAlter!strDeprectionFactor = "2" Then
    '                If blnInit Or Not (intYear = gclsBase.BeginYear And intPeriod = gclsBase.PeriodOfDate(gclsBase.BeginDate)) Then
                        !dblCalcDeprection = 0
    '                Else
    '                    !dblCalcDeprection = -!dblDeprection
    '                End If
                Else
                    !dblCalcDeprection = dblCalcDeprection
                End If
                !intBeelinePeriod = intBeelinePeriod - IIf(recFixedAlter!strDeprectionFactor = "2" And Not blnInit, !intPeriod, 0)
            End If
            .Update
        End With
        recFixedBalance.Close
        Set recFixedBalance = Nothing
        UpdateAfterFixedBalance recFixedAlter!lngFixedCardID, intYear, intPeriod
    End If
    recFixedAlter.Close
    Set recFixedAlter = Nothing
End Sub

'取消折旧
Public Sub CancelDeprection(ByVal intYear As Integer, ByVal intPeriod As Integer)
    Dim strSql As String
    Dim rec As rdoResultset
    Dim blnIsFirst As Boolean
    blnIsFirst = False
    strSql = "UPDATE FixedBalance SET dblDeprection=0,intPeriod=0,dblPeriodDeprection=0 " _
        & "WHERE intYear=" & intYear & " AND bytPeriod=" & intPeriod
    gclsBase.ExecSQL strSql
    strSql = "DELETE FROM FixedBalance WHERE intYear=" & intYear & " AND bytPeriod=" & intPeriod _
        & " AND dblWork=0 AND lngFixedCardID NOT IN (SELECT lngFixedCardID FROM FixedAlter " _
        & "WHERE intYear=" & intYear & " AND bytPeriod=" & intPeriod & ")"
    gclsBase.ExecSQL strSql
    strSql = "DELETE FROM FixedDepr1 WHERE intYear=" & intYear & " AND bytPeriod=" & intPeriod
    gclsBase.ExecSQL strSql
    strSql = "DELETE FROM FixedDepr2 WHERE intYear=" & intYear & " AND bytPeriod=" & intPeriod
    gclsBase.ExecSQL strSql
'    判断是否为第一个会计期间
'    strSql = "SELECT TOP 1 * FROM FixedBalance WHERE CLng(intYear)*100+bytPeriod<" & CLng(intYear) * 100 + intPeriod
'    Set rec = gclsBase.BaseDB.OpenResultset(strsql, rdOpenstatic)
'    若为期初则更新本期的折旧数据
'    If rec.EOF Then
'        strSql = "UPDATE FixedBalance,FixedAlter SET FixedBalance.dblCalcDeprection" _
'            & "=IIF(FixedAlter.strDeprectionFactor='2',0, FixedBalance.dblInitDeprection) WHERE " _
'            & "FixedAlter.intYear=" & intYear & " AND FixedBalance.intYear=" & intYear _
'            & " AND FixedBalance.bytPeriod=" & intPeriod & " AND FixedAlter.bytPeriod=" & intPeriod
'        gclsBase.ExecSQL strSql
'        blnIsFirst = True
'    Else
'        strSql = "UPDATE FixedBalance SET dblCalcDeprection=dblInitDeprection " _
'            & "WHERE intYear=" & intYear & " AND bytPeriod=" & intPeriod
'        gclsBase.ExecSQL strSql
'    End If
'    UpdateMonthFixedAlter intYear, intPeriod
    If blnIsFirst Then
'        strSql = "UPDATE FixedBalance,FixedAlter SET FixedBalance.intPeriod=0,FixedBalance.dblCalcDeprection" _
'            & "=IIF(FixedAlter.strDeprectionFactor='2',0, FixedBalance.dblInitDeprection) WHERE " _
'            & "FixedAlter.intYear=" & intYear & " AND FixedBalance.intYear=" & intYear _
'            & " AND FixedBalance.bytPeriod=" & intPeriod & " AND FixedAlter.bytPeriod=" & intPeriod
'        gclsBase.ExecSQL strSql
    End If
End Sub

'根据上一期间数据增加本月数据
Public Sub CopyBalanceFromLast(intYear As Integer, intPeriod As Integer, lngCardID As Long)
    Dim strSql As String
    Dim recFixedBalance As rdoResultset
    Dim recPreFixedBalance As rdoResultset
    Dim dblInitAmount As Double
    Dim dblInitDeprection As Double
    Dim dblInitAccumaWork As Double
    Dim intCalcPeriod As Integer
    Dim intCalcUseAge As Integer
    Dim dblCalcAmount As Double
    Dim dblCalcDeprection As Double
    
    strSql = "SELECT * FROM FixedBalance WHERE lngFixedCardID=" & lngCardID _
        & " AND intYear*100+bytPeriod<" & CLng(intYear) * 100 + intPeriod _
        & " ORDER BY intYear DESC,bytPeriod DESC"
    Set recPreFixedBalance = gclsBase.BaseDB.OpenResultset(strSql, rdOpenDynamic, rdConcurValues)
    If Not recPreFixedBalance.EOF Then
        With recPreFixedBalance
            dblInitAmount = !dblInitAmount + !dblDebitAmount + !dblCreditAmount
            dblInitDeprection = !dblInitDeprection + !dblDeprection + !dblAlterDeprection
            dblInitAccumaWork = !dblInitAccumaWork + !dblWork
            intCalcPeriod = !intCalcPeriod + !intPeriod
            intCalcUseAge = !intCalcUseAge
            dblCalcAmount = !dblCalcAmount + !dblDebitAmount + !dblCreditAmount
            dblCalcDeprection = !dblCalcDeprection + !dblDeprection
        End With
    End If
    
    strSql = "SELECT * FROM FixedBalance WHERE intYear=" & intYear _
        & " AND bytPeriod=" & intPeriod & " AND lngFixedCardID=" & lngCardID
    Set recFixedBalance = gclsBase.BaseDB.OpenResultset(strSql, rdOpenDynamic, rdConcurValues)
    With recFixedBalance
        If .EOF Then
            .AddNew
            !intYear = intYear
            !bytPeriod = intPeriod
            !lngFixedCardID = lngCardID
            !intCalcPeriod = intCalcPeriod
            !intCalcUseAge = intCalcUseAge
            !dblCalcAmount = dblCalcAmount
            !dblCalcDeprection = dblCalcDeprection
        Else
            .Edit
        End If
        !dblInitAmount = dblInitAmount
        !dblInitDeprection = dblInitDeprection
        !dblInitAccumaWork = dblInitAccumaWork
        .Update
    End With
End Sub

Public Sub UpdateFixedBalanceAfterDelete(ByVal lngCardID As Long, ByVal intYear As Integer, ByVal bytPeriod As Integer, ByVal lngLastFixedAlterID As Long)
    Dim recBalance As rdoResultset
    Dim strSql As String
    Dim intUseAge As Integer
    Dim intBeelinePeriod As Integer
    Dim dblCalcAmount As Double
    Dim intCalcPeriod As Integer
    Dim dblCalcDeprection As Double
    
    On Error GoTo ErrHandle
    
    strSql = "SELECT * FROM FixedBalance WHERE lngFixedCardID=" & lngCardID _
        & " AND intYear * 100 + bytPeriod < " & CLng(intYear) * 100 + bytPeriod _
        & " ORDER BY intYear Desc,bytPeriod Desc"
    Set recBalance = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If Not recBalance.EOF Then
        recBalance.MoveFirst
        intUseAge = recBalance!intCalcUseAge
        dblCalcAmount = recBalance!dblCalcAmount
        dblCalcDeprection = recBalance!dblCalcDeprection + recBalance!dblDeprection
        intCalcPeriod = recBalance!intCalcPeriod + recBalance!intPeriod
        intBeelinePeriod = recBalance!intBeelinePeriod
        strSql = "UPDATE FixedBalance SET intCalcUseAge=" & intUseAge _
            & ",dblCalcAmount=" & dblCalcAmount & ",intCalcPeriod=" & intCalcPeriod _
            & ",dblCalcDeprection=" & dblCalcDeprection & ",intBeelinePeriod=" & intBeelinePeriod _
            & " WHERE lngFixedCardID=" & lngCardID & " AND intYear=" & intYear _
            & " AND bytPeriod=" & bytPeriod
        gclsBase.ExecSQL strSql
    Else
        UpdateFixedBalance lngLastFixedAlterID
    End If
    recBalance.Close
    Set recBalance = Nothing
    Exit Sub
ErrHandle:
    ShowMsg frmMain.hwnd, "程序出错：" & Err.Description, vbOKOnly + vbCritical, "删除固定资产"
End Sub

'写FixedBalance表
Public Sub AddEmptyFixedBalance()
    Dim strSql As String
    Dim recRecordset As rdoResultset
    Dim recBalance As rdoResultset
    Dim intUseAge As Integer
    Dim intBeelinePeriod As Integer