frmfixedoldwizard.frm

金算盘软件代码

'    '工作量法第一个月提折旧
'    strSql = "SELECT * FROM FixedAlter WHERE (FixedAlter.strDeprectionFactor)<>'0' AND " _
'        & "TO_DATE(FixedAlter.strDate,'YYYY-MM-DD')>=TO_DATE('" & Format(datCalcFromDate, "yyyy-mm-dd") _
'        & "','YYYY-MM-DD') AND (TO_DATE(FixedAlter.strDate,'YYYY-MM-DD')<TO_DATE('" _
'        & Format(datNowDate, "yyyy-mm-dd") & "','YYYY-MM-DD') OR TO_DATE(FixedAlter.strDate,'YYYY-MM-DD')<=TO_DATE('" _
'        & Format(datEndDate, "yyyy-mm-dd") & "','YYYY-MM-DD') AND strDepreciationMethod='3')"
'    Set recFixedAlter = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
'    '将开始计算期间的
'    msgOldWizard.FixedCols = 0
'    '取出开始计算的期间的结束日期以前的变动记录（为下一个会计期间的计算依据）
'    strSql = "SELECT FixedAccount.lngAccountID,Account.lngAccountID AS ID,Account.strAccountCode AS Code," _
'        & " Account.strAccountCode+' '+Account.strAccountName AS AccountName,Format((FixedAccount.dblRate*" _
'        & "FixedBalance.dblPeriodDeprection)/100,'#,###.00') AS Amount ,'' AS 贷方金额, " _
'        & "FixedAlter.lngFixedAlterID,Account.blnIsDepartment,FixedBalance.dblPeriodDeprection, " _
'        & "FixedBalance.lngFixedCardID,FixedAccount.dblRate FROM ((FixedAlter INNER JOIN FixedAccount ON " _
'        & "FixedAlter.lngFixedAlterID = FixedAccount.lngFixedAlterID) INNER JOIN  FixedBalance ON " _
'        & "FixedBalance.lngFixedCardID=FixedAlter.lngFixedCardID  AND (FixedBalance.intYear = " _
'        & "FixedAlter.intYear) AND (FixedBalance.bytPeriod = FixedAlter.bytPeriod)) INNER JOIN Account " _
'        & "ON Account.lngAccountID = FixedAccount.lngAccountID WHERE (FixedAlter.blnIsVoid)=0 AND " _
'        & "FixedAlter.lngFixedAlterID IN (SELECT Max(FixedAlter.lngFixedAlterID) AS lngFixedAlterID FROM " _
'        & "FixedAlter WHERE FixedAlter.strDeprectionFactor<>'0' AND TO_DATE(FixedAlter.strDate,'YYYY-MM-DD')" _
'        & "<TO-DATE('" & Format(datCalcFromDate, "YYYY-MM-DD") & "','YYYY-MM-DD') GROUP BY FixedAlter.lngFixedCardID) " _
'        & "AND FixedBalance.dblPeriodDeprection>0"
'    Set recOldAccount = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
'    prgVoucher.Value = 60
'    blnIsZero = True
'    If Not recOldAccount.EOF Then
'        recOldAccount.MoveLast
'        recOldAccount.MoveFirst
'        '折旧分摊
'        blnIsZero = False
'        FixedOldPartDetail recOldAccount
'    End If
'    If Not recFixedAlter.EOF Then
'        msgOldWizard.FixedCols = 0
'        recFixedAlter.MoveLast
'        recFixedAlter.MoveFirst
'        Do While Not recFixedAlter.EOF
'            strSql = "SELECT FixedAccount.lngAccountID,Account.lngAccountID AS ID,Account.strAccountCode AS Code," _
'                & " Account.strAccountCode+' '+Account.strAccountName AS AccountName,'' AS 贷方金额 " _
'                & ", Format((FixedAccount.dblRate*FixedBalance.dblPeriodDeprection)/100,'#,###.00') AS Amount, " _
'                & "FixedAlter.lngFixedAlterID,Account.blnIsDepartment,FixedBalance.dblPeriodDeprection," _
'                & "FixedBalance.lngFixedCardID,FixedAccount.dblRate FROM ((FixedAlter INNER JOIN FixedAccount ON " _
'                & "FixedAlter.lngFixedAlterID = FixedAccount.lngFixedAlterID) INNER JOIN  FixedBalance ON " _
'                & "FixedBalance.lngFixedCardID=FixedAlter.lngFixedCardID) INNER JOIN Account ON Account.lngAccountID " _
'                & "= FixedAccount.lngAccountID WHERE FixedAlter.intYear=FixedBalance.intYear AND " _
'                & "FixedAlter.bytPeriod=FixedBalance.bytPeriod AND (FixedAlter.blnIsVoid)=0 AND " _
'                & "FixedAlter.lngFixedAlterID=" & recFixedAlter!lngFixedAlterID & " AND " _
'                & "FixedBalance.dblPeriodDeprection>0 "
'            Set recOldAccount = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
'            If Not recOldAccount.EOF Then
'                recOldAccount.MoveLast
'                recOldAccount.MoveFirst
'                '折旧分摊
'                FixedOldPartDetail recOldAccount
'                blnIsZero = False
'            End If
'            recFixedAlter.MoveNext
'        Loop
'        prgVoucher.Value = 90
'        If Not recOldAccount.EOF Then
'            recOldAccount.MoveLast
'            recOldAccount.MoveFirst
'            '折旧分摊
'            FixedOldPartDetail recOldAccount
'            blnIsZero = False
'        End If
'    End If
'    If blnIsZero Then
'        stbOldWizard.Tab = 0
'        ShowMsg Me.hWnd, "折旧计算结果为零，不能生成凭证", vbInformation, Me.Caption
'        mblnVoucherFinish = False
'        prgVoucher.Visible = False
'        recOldAccount.Close
'        Set recOldAccount = Nothing
'        Exit Sub
'    End If
'    msgOldWizard.Rows = msgOldWizard.Rows - 1
'    mclsGrid.SetupStyle
'    dblValue = 0
'    '累计折旧科目
'    With msgOldWizard
'        If .Rows = 1 Then
'            Exit Sub
'        End If
'        i = 1
'        Do While i < .Rows
'           dblValue = dblValue + .TextMatrix(i, 9)
'           i = i + 1
'        Loop
'        If dblValue > 0 Then
'            .AddItem ("")
'            .TextMatrix(.Rows - 1, 0) = litAccount.TextMatrix(litAccount.ReferRow, 1)
'            .TextMatrix(.Rows - 1, 1) = litAccount.TextMatrix(litAccount.ReferRow, 2)
'            .TextMatrix(.Rows - 1, 8) = litAccount.TextMatrix(litAccount.ReferRow, 2) & " " & litAccount.TextMatrix(litAccount.ReferRow, 3)
'            .TextMatrix(.Rows - 1, 10) = IIf(dblValue < 1, Format(dblValue, "0.00"), Format(dblValue, "###,###,###.00"))   'Format(dblValue, "###,###,###.00")
'            mdblValue = dblValue
'            .TextMatrix(.Rows - 1, 2) = 0
'            .TextMatrix(.Rows - 1, 3) = 0
'            .TextMatrix(.Rows - 1, 4) = 0
'            .TextMatrix(.Rows - 1, 5) = 0
'            .TextMatrix(.Rows - 1, 6) = 0
'            .TextMatrix(.Rows - 1, 7) = 0
'        End If
'    End With
'    prgVoucher.Value = 100
'    prgVoucher.Visible = False
'    recOldAccount.Close
'    Set recOldAccount = Nothing
    
    Dim recOldAccount As rdoResultset
    Dim strSql As String
    Dim i As Integer
    Dim dblValue As Double
    Dim intYear As Integer
    Dim bytPeriod As Byte
    Dim datStartDate As Date
    Dim datEndDate As Date
    Dim rec As rdoResultset
    Dim recFixedAlter As rdoResultset
    Dim blnIsFirst As Boolean
    Dim blnDec As Boolean
    Dim datDate As Date
    Dim intFirstYear As Integer
    Dim bytFirstPeriod As Byte
    Dim datFirstDate As Date
    Dim datNowDate As Date
    Dim blnIsZero As Boolean
    Dim intFromYear As Integer
    Dim bytFromPeriod As Byte
    Dim datCalcFromDate As Date
    strSql = "DELETE FROM FixedDepr1 WHERE intYear=" & gclsBase.AccountYear & " AND bytPeriod=" & gclsBase.Period
    gclsBase.ExecSQL strSql
    strSql = "DELETE FROM FixedDepr2 WHERE intYear=" & gclsBase.AccountYear & " AND bytPeriod=" & gclsBase.Period
    gclsBase.ExecSQL strSql
    msgOldWizard.Clear
    msgOldWizard.Rows = 2
    intYear = gclsBase.AccountYear
    bytPeriod = gclsBase.Period
    '判断当前会计期间是否为第一个会计期间
    strSql = "SELECT AccountPeriod.intYear, AccountPeriod.bytPeriod,Business.strStartDate FROM Business, " _
        & "AccountPeriod WHERE (Business.strStartDate <= AccountPeriod.strEndDate) AND " _
        & "(Business.strStartDate >= AccountPeriod.strStartDate)"
    Set rec = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If rec!intYear = intYear And rec!bytPeriod = bytPeriod Then
        blnIsFirst = True
    End If
    intFirstYear = rec!intYear
    bytFirstPeriod = rec!bytPeriod
    datFirstDate = rec!strStartDate
    Call gclsBase.DateOfPeriod(intYear, bytPeriod, datNowDate)
    '判断是否已经计提过折旧
    strSql = "SELECT Voucher.* FROM Voucher WHERE Voucher.lngVoucherSourceID=15 AND blnIsVoid=0 ORDER BY intYear*100+bytPeriod ASC"
    Set rec = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If rec.EOF Then
        blnDec = False
        Call gclsBase.DateOfPeriod(intFirstYear, CByte(bytFirstPeriod), datStartDate, datEndDate)
        intFromYear = intFirstYear
        bytFromPeriod = bytFirstPeriod
        datCalcFromDate = datStartDate
    Else
        blnDec = True
        rec.MoveLast
        Call gclsBase.DateOfPeriod(rec!intYear, CByte(rec!bytPeriod), datStartDate, datEndDate)  '
        datCalcFromDate = datEndDate + 1
        intFromYear = rec!intYear
        bytFromPeriod = rec!bytPeriod
    End If
    msgOldWizard.Rows = 2
    msgOldWizard.FixedRows = 1
    msgOldWizard.Cols = 11
    msgOldWizard.FixedCols = 9
    msgOldWizard.ColWidth(1) = 0
    msgOldWizard.ColWidth(2) = 0
    msgOldWizard.ColWidth(3) = 0
    msgOldWizard.ColWidth(4) = 0
    msgOldWizard.ColWidth(5) = 0
    msgOldWizard.ColWidth(6) = 0
    msgOldWizard.ColWidth(7) = 0
    msgOldWizard.ColWidth(8) = 2880
    msgOldWizard.ColWidth(9) = 1200
    msgOldWizard.ColWidth(10) = 1200
    msgOldWizard.ColAlignment(8) = 1
    msgOldWizard.TextMatrix(0, 8) = "科目名称"
    msgOldWizard.TextMatrix(0, 9) = "借方金额"
    msgOldWizard.TextMatrix(0, 10) = "贷方金额"
    '将开始计算期间的
    msgOldWizard.FixedCols = 0
    '取出开始计算的期间的结束日期以前的变动记录（为下一个会计期间的计算依据）
    strSql = "SELECT FixedAccount.lngAccountID,Account.lngAccountID AS ID,Account.strAccountCode AS Code," _
        & " Account.strAccountCode || ' ' || Account.strAccountName AS AccountName,TO_CHAR((FixedAccount.dblRate*" _
        & "FixedBalance.dblPeriodDeprection/100),'999,999,999.00') AS Amount ,' ' AS 贷方金额, " _
        & "FixedAlter.lngFixedAlterID ,Account.blnIsDepartment,FixedBalance.dblPeriodDeprection," _
        & "FixedBalance.lngFixedCardID,FixedAccount.dblRate " _
        & "FROM FixedCard,FixedAlter,FixedAccount,FixedBalance,Account " _
        & "WHERE FixedCard.lngRecentFixedAlterID=FixedAlter.lngFixedAlterID " _
        & "AND FixedBalance.lngFixedCardID=FixedCard.lngFixedCardID " _
        & "AND FixedAlter.lngFixedAlterID=FixedAccount.lngFixedAlterID " _
        & "AND FixedAccount.lngAccountID=Account.lngAccountID " _
        & "AND FixedBalance.dblPeriodDeprection>0"
    Set recOldAccount = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    prgVoucher.Value = 60
    blnIsZero = True
    If Not recOldAccount.EOF Then
        recOldAccount.MoveLast
        recOldAccount.MoveFirst
        '折旧分摊
        blnIsZero = False
        FixedOldPartDetail recOldAccount
    Else
        stbOldWizard.Tab = 0
        ShowMsg Me.hwnd, "折旧计算结果为零，不能生成凭证", vbInformation, Me.Caption
        mblnVoucherFinish = False
        prgVoucher.Visible = False
        recOldAccount.Close
        Set recOldAccount = Nothing
        Exit Sub
    End If
    msgOldWizard.Rows = msgOldWizard.Rows - 1
    mclsGrid.SetupStyle
    dblValue = 0
    '累计折旧科目
    With msgOldWizard
        If .Rows = 1 Then
            Exit Sub
        End If
        i = 1
        Do While i < .Rows
           dblValue = dblValue + .TextMatrix(i, 9)
           i = i + 1
        Loop
        If dblValue > 0 Then
            .AddItem ("")
            .TextMatrix(.Rows - 1, 0) = litAccount.TextMatrix(litAccount.ReferRow, 1)
            .TextMatrix(.Rows - 1, 1) = litAccount.TextMatrix(litAccount.ReferRow, 2)
            .TextMatrix(.Rows - 1, 8) = litAccount.TextMatrix(litAccount.ReferRow, 2) & " " & litAccount.TextMatrix(litAccount.ReferRow, 3)
            .TextMatrix(.Rows - 1, 10) = IIf(dblValue < 1, Format(dblValue, "0.00"), Format(dblValue, "###,###,###.00"))   'Format(dblValue, "###,###,###.00")
            mdblValue = dblValue
            .TextMatrix(.Rows - 1, 2) = 0
            .TextMatrix(.Rows - 1, 3) = 0
            .TextMatrix(.Rows - 1, 4) = 0
            .TextMatrix(.Rows - 1, 5) = 0
            .TextMatrix(.Rows - 1, 6) = 0
            .TextMatrix(.Rows - 1, 7) = 0
        End If
    End With
    prgVoucher.Value = 100
    prgVoucher.Visible = False
    recOldAccount.Close
    Set recOldAccount = Nothing
End Sub
'计算折旧
Private Sub oldFixedVoucher()
'    Dim strSql As String
'    Dim recResultset As rdoResultset
'    Dim intyear As Integer
'    Dim bytPeriod As Byte
'    bytPeriod = gclsBase.Period
'    intyear = Year(gclsBase.BaseDate)
'    strSql = "SELECT Voucher.intVoucherNO,VoucherType.strVoucherTypeName FROM Voucher INNER JOIN VoucherType" _
'        & " ON Voucher.lngVoucherTypeID = VoucherType.lngVoucherTypeID WHERE Voucher.lngVoucherSourceID=15 AND " _
'        & " CLng(Voucher.intYear)*100+bytPeriod>=" & (CLng(intyear) * 100 + bytPeriod) & " AND Voucher.blnIsVoid=0"
'    Set recResultset = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
'    '已经有凭证的会计期间
'    If Not recResultset.EOF Then
'        stbOldWizard.Tab = 0
'        ShowMsg Me.hWnd, "本会计期间已提折旧或本会计期间以后的会计期间已提折旧，请删除" & recResultset!strVoucherTypeName & "字第" _
'            & recResultset!intVoucherNO & "号的凭证再提折旧", vbInformation, Me.Caption
'        mblnVoucherFinish = False
'        Exit Sub
'    End If
'    '本会计期间已经结帐
'    If gclsBase.PeriodClosed(gclsBase.BaseDate) Then
'        stbOldWizard.Tab = 0
'        ShowMsg Me.hWnd, "本会计期间已经结帐，不能计提折旧", vbInformation, Me.Caption
'        mblnVoucherFinish = False
'        Exit Sub
'    End If
'    If Val(litAccount.TextMatrix(litAccount.ReferRow, 1)) = 0 Then
'        stbOldWizard.Tab = 0
'        ShowMsg Me.hWnd, "请选择折旧科目", vbInformation, Me.Caption
'        mblnVoucherFinish = False
'        litAccount.SetFocus
'        Exit Sub
'    End If
'    Me.MousePointer = vbHourglass
'    If Not mblnVoucherFinish Then
'        mblnVoucherFinish = True
'        mblnHaveDeprection = True
'        '计提折旧
'    If Not mblnVoucherFinish Then
'        Me.MousePointer = vbHourglass
'        mblnVoucherFinish = True
'        '计提折旧
'        Set ref = gclsBase.BaseDB.CreateQuery("", "{?=CALL Deprection(?,?)}")
'        ref.rdoParameters(0).Type = rdTypeVARCHAR
'        ref.rdoParameters(1).Type = rdTypeINTEGER
'        ref.rdoParameters(1).Direction = rdParamInput
'        ref.rdoParameters(1).Value = gclsBase.AccountYear
'        ref.rdoParameters(2).Type = rdTypeINTEGER
'        ref.rdoParameters(2).Direction = rdParamInput
'        ref.rdoParameters(2).Value = gclsBase.Period
'        ref.Execute
'        If Val(ref.rdoParameters(0).Value) > 0 Then
'            Call FixedOldPart
'        Else
'            prgVoucher.Visible = False
'            stbOldWizard.Tab = 0
'            ShowMsg Me.hWnd, "没有固定资产可以计提折旧", vbInformation, Me.Caption
'            mblnVoucherFinish = False
'        End If
'    End If
'    Me.MousePointer = vbDefault
    Dim strSql As String
    Dim recRecordset As rdoResultset
    Dim intYear As Integer
    Dim bytPeriod As Byte
    Dim ref As rdoQuery
    If Not ExclusiveIn("计提折旧", mclsMainControl.LogID, , "增加固定资产期初 固定资产增加 固定资产减少 固定资产其他变动") Then
        stbOldWizard.Tab = 0
        mblnVoucherFinish = False
        Exit Sub
    End If
    bytPeriod = gclsBase.Period
    intYear = Year(gclsBase.BaseDate)
    strSql = "SELECT Voucher.intVoucherNO,VoucherType.strVoucherTypeName FROM Voucher,VoucherType" _
        & " WHERE Voucher.lngVoucherTypeID = VoucherType.lngVoucherTypeID AND Voucher.lngVoucherSourceID=15 AND " _
        & " Voucher.intYear*100+bytPeriod>=" & (CLng(intYear) * 100 + bytPeriod) & " AND Voucher.blnIsVoid=0"
    Set recRecordset = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    '已经有凭证的会计期间
    If Not recRecordset.EOF Then
        stbOldWizard.Tab = 0
        ShowMsg Me.hwnd, "本会计期间已提折旧或本会计期间以后的会计期间已提折旧，请删除" & recRecordset!strVoucherTypeName & "字第" _
            & recRecordset!intVoucherNO & "号的凭证再提折旧", vbInformation, Me.Caption