frmend.frm

金算盘软件代码

    '检查本期是否有未记帐凭证
    If ValidPeriod Then
        
        strSql = "SELECT Voucher.lngVoucherID FROM Voucher INNER JOIN VoucherDetail " _
            & "ON Voucher.lngVoucherID=VoucherDetail.lngVoucherID " _
            & "WHERE lngPostID=0 AND strDate>='" _
            & Format(dtmStart, "YYYY-MM-DD") & "' AND strDate<='" & Format(dtmEnd, "yyyy-mm-dd") _
            & "' AND blnIsVoid=0"
        Set recTmp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
        If Not recTmp.EOF Then
            If AccountInUse() Then
                ValidPeriod = False
                Msg = "本期还有未记帐凭证"
            Else
                mstrMsgVoucher = IIf(mstrMsgVoucher = "", "", mstrMsgVoucher & Chr(13) & Chr(10)) & "本期还有未记帐凭证！"
            End If
        End If
        recTmp.Close
    End If
    
    strSql = "SELECT * FROM AccountPeriod WHERE " _
            & "intYear=" & mintYear & " AND bytPeriod=" & mintPeriod
    Set recPeriod = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    
    If Not recPeriod.EOF Then
        
        '检查本期间是否需要结转成本差异(进销差价)
        If ValidPeriod Then
            strQItemCostItemSql = TransferPublic.getQItemCostItemOraSql
            strTmp = Format(dtmStart, "yyyy-mm-dd")
            strQItemCostItemSql = Replace(strQItemCostItemSql, "[BeginDate]", "'" & strTmp & "'")
            strTmp = Format(dtmEnd, "yyyy-mm-dd")
            strQItemCostItemSql = Replace(strQItemCostItemSql, "[EndDate]", "'" & strTmp & "'")
            Set recTmp = gclsBase.BaseDB.OpenResultset(strQItemCostItemSql, rdOpenStatic)
            If Not recTmp.EOF Then
                '是否有未计算成本的项目
                strQItemCostNotCalcSql = TransferPublic.getQItemCostNotCalcOraSql
                strTmp = Format(dtmEnd, "yyyy-mm-dd")
                strQItemCostNotCalcSql = Replace(strQItemCostNotCalcSql, "[EndDate]", "'" & strTmp & "'")
                Set recTmp = gclsBase.BaseDB.OpenResultset(strQItemCostNotCalcSql, rdOpenStatic)
                If recTmp.EOF Then
                    strSql = "SELECT * FROM Voucher WHERE lngVoucherSourceID=" & vsCost _
                        & " AND intYear=" & mintYear & " AND bytPeriod=" & mintPeriod
                    Set recTmp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
                    If recTmp.EOF Then
                        strSql = "SELECT lngActivityDetailID FROM ItemActivity,ItemActivityDetail " _
                            & "WHERE ItemActivity.lngActivityID=ItemActivityDetail.lngActivityID " _
                            & " AND blnIsVoid=0 AND strDate='" & Format(dtmStart, "yyyy-mm-dd") _
                            & "' AND strDate<='" & Format(dtmEnd, "yyyy-mm-dd") _
                            & "' AND dblQuantity<>0 AND (dblPlanPrice>0 AND (dblCostDiff-dblSaleTax)<>0 AND lngActivityTypeID IN (" & atOutSale _
                            & "," & atOutEntrust & "," & atOutLend & "," & atOutStage & "))"
                        Set recTmp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
                        If Not recTmp.EOF Then
                            If mblnControl Then
                                ValidPeriod = False
                                Msg = "本期未结转成本差异(或进销差价)，不能结帐！"
                            Else
                                mstrMsgVoucher = IIf(mstrMsgVoucher = "", "", mstrMsgVoucher & Chr(13) & Chr(10)) & "本期未结转成本差异(或进销差价)！"
                            End If
                        End If
                    End If
                Else
                    ValidPeriod = False
                    Msg = "本期须重新计算并重新结转成本！"
                End If
            End If
            recTmp.Close
        End If
    
        '检查收款付款、应收应付凭证是否生成
        If ValidPeriod Then
            strSql = "SELECT lngActivityTypeID FROM Activity WHERE lngVoucherID<=0 " _
                & " AND strDate>='" & Format(dtmStart, "yyyy-mm-dd") & "'" _
                & " AND strDate<='" & Format(dtmEnd, "yyyy-mm-dd") & "'" _
                & " AND (blnIsVoid=0)"
            Set recTmp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
            If Not recTmp.EOF Then
                If mblnControl Then
                    ValidPeriod = False
                    If recTmp!lngActivityTypeID = atReceipt Or recTmp!lngActivityTypeID = atPayment Then
                        Msg = "本期收款付款单未全部生成凭证，不能结帐！"
                    Else
                        Msg = "本期应收应付单未全部生成凭证，不能结帐！"
                    End If
                Else
                    mstrMsgVoucher = IIf(mstrMsgVoucher = "", "", mstrMsgVoucher & Chr(13) & Chr(10)) & "本期收款付款单未全部生成凭证！"
                End If
            End If
        End If
        
        '检查购销业务凭证是否生成
        If ValidPeriod Then
            strSql = "SELECT lngActivityTypeID,dblCurrInvoiceAmount FROM ItemActivity,ItemActivityDetail " _
                    & " WHERE ItemActivity.lngActivityID=ItemActivityDetail.lngActivityID " _
                    & " AND ( blnIsVoid=0) AND (lngVoucherID=0 OR lngVoucherID1=0) AND lngActivityTypeID " _
                    & "IN (" & atInPurchase & "," & atInDirectPurchase & "," & atInBorrow & "," _
                    & atInEntrust & "," & atInEntrustExpense & "," & atInSelf & "," & atInOther & "," _
                    & atInStock & "," & atOutSale & "," & atOutLendSettlement & "," & atOutStageSettlement & "," _
                    & atOutDirectSale & "," & atOutLend & "," & atOutEntrust & "," & atOutStage & "," _
                    & atOutCostAdjust & "," & atOutStock & "," & atOutSelf & "," & atOutOther _
                    & "," & atInVentoryPrice & "," & atInBorrowSettlement & ") " _
                    & " AND strDate>='" & Format(dtmStart, "yyyy-mm-dd") & "'" _
                    & " AND strDate<='" & Format(dtmEnd, "yyyy-mm-dd") & "'"
            Set recTmp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
            If Not recTmp.EOF Then
                Do While Not recTmp.EOF
                    If recTmp!lngActivityTypeID = atOutSale And recTmp!dblCurrInvoiceAmount = 0 Then
                        Exit Do
                    End If
                    recTmp.MoveNext
                Loop
                If Not recTmp.EOF Then
                    If mblnControl Then
                        ValidPeriod = False
                        Msg = "购销单据未全部生成凭证，不能结帐！"
                    Else
                        mstrMsgVoucher = IIf(mstrMsgVoucher = "", "", mstrMsgVoucher & Chr(13) & Chr(10)) & "购销单据未全部生成凭证！"
                    End If
                End If
            End If
            recTmp.Close
        End If
        
        '检查工资凭证是否生成
        If ValidPeriod Then
            strSql = "SELECT lngSalaryListID FROM SalaryList WHERE strDate>='" & Format(dtmStart, "yyyy-mm-dd") & "'" _
                & " AND strDate<='" & Format(dtmEnd, "yyyy-mm-dd") & "'"
            Set recTmp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
            If Not recTmp.EOF Then
                strSql = "SELECT * FROM Voucher WHERE lngVoucherSourceID=" & vsSalary _
                    & " AND intYear=" & mintYear & " AND bytPeriod=" & mintPeriod
                Set recTmp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
                If recTmp.EOF Then
                    If mblnControl Then
                        ValidPeriod = False
                        Msg = "本期工资凭证未生成，不能结帐！"
                    Else
                        mstrMsgVoucher = IIf(mstrMsgVoucher = "", "", mstrMsgVoucher & Chr(13) & Chr(10)) & "本期未生成工资凭证！"
                    End If
                End If
            End If
            recTmp.Close
        End If

        '检查固定资产是否作凭证
        If ValidPeriod Then
            strSql = "SELECT * FROM FixedBalance WHERE intYear=" & mintYear & " AND bytPeriod=" & mintPeriod _
                & " AND (dblDebitAmount>0 OR dblCreditAmount<>0 OR dblAlterDeprection<>0) "
            Set recTmp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
            If Not recTmp.EOF Then
                strSql = "SELECT lngFixedAlterID,intVoucherNo FROM FixedAlter,Voucher " _
                    & " WHERE FixedAlter.lngVoucherID=Voucher.lngVoucherID(+) " _
                    & " AND (dblDebitAmount<>0 OR dblCreditAmount<>0 OR dblAlterDeprection<>0) " _
                    & "AND FixedAlter.strDate>='" & Format(dtmStart, "yyyy-mm-dd") & "'" _
                    & "AND FixedAlter.strDate<='" & Format(dtmEnd, "yyyy-mm-dd") & "'" _
                    & "AND (blnIsVoucher=0) AND NVL(intVoucherNO,0)=0"
                Set recTmp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
                If Not recTmp.EOF Then
                    If mblnControl Then
                        ValidPeriod = False
                        Msg = "本期固定资产变动未全部生成凭证，不能结帐！"
                    Else
                        mstrMsgVoucher = IIf(mstrMsgVoucher = "", "", mstrMsgVoucher & Chr(13) & Chr(10)) & "本期固定资产变动未全部生成凭证！"
                    End If
                End If
            End If
            recTmp.Close
        End If
    
        '检查固定资产是否提折旧
        If ValidPeriod Then
            strSql = "SELECT FixedType.strDepreciationType,FixedAlter.bytAlterType,FixedAlter.strFixedState," _
                & "FixedAlter.strDepreciationMethod,FixedAlter.dblAmount,FixedAlter.dblDeprection,FixedAlter.dblNetWorth " _
                & "FROM FixedCard,FixedType,FixedAlter " _
                & " WHERE( FixedCard.lngFixedTypeID=FixedType.lngFixedTypeID) " _
                & " AND FixedCard.lngRecentFixedAlterID=FixedAlter.lngFixedAlterID " _
                & " AND FixedType.strDepreciationType<>2 AND FixedAlter.strDepreciationMethod<>'1' AND bytAlterType<>2 " _
                & " AND strFixedState<>'2' AND strFixedState<>'3' AND (FixedAlter.strDate<'" & Format(dtmStart, "yyyy-mm-dd") & "'" _
                & " AND FixedCard.lngCreateFixedAlterID=FixedCard.lngRecentFixedAlterID " _
                & " OR FixedCard.lngCreateFixedAlterID<>FixedCard.lngRecentFixedAlterID)"
            Set recTmp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
            If Not recTmp.EOF Then
                strSql = "SELECT * FROM Voucher WHERE lngVoucherSourceID=" & vsFixedDeprection _
                    & " AND intYear=" & mintYear & " AND bytPeriod=" & mintPeriod
                Set recTmp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
                If recTmp.EOF Then
                    If mblnControl Then
                        ValidPeriod = False
                        Msg = "本期固定资产未计提折旧，不能结帐！"
                    Else
                        mstrMsgVoucher = IIf(mstrMsgVoucher = "", "", mstrMsgVoucher & Chr(13) & Chr(10)) & "本期固定资产未计提折旧！"
                    End If
                End If
            End If
            recTmp.Close
        End If
    End If
    recPeriod.Close
    
    '损益类(收入支出)科目未结平
    If ValidPeriod Then
        If mintPeriod = mintPeriodNum Then
            strSql = "SELECT strAccountCode FROM Account WHERE intLevel=1 AND blnIsInActive=0"
            Set recZ = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
            If Not recZ.EOF Then
                strQAccountBalanceSql = TransferPublic.getQAccountBalanceOraSql(Format(mdtmEnd, "yyyy-mm-dd"))
                strSql = "SELECT SUBSTR(strAccountCode,0," & Len(recZ!strAccountCode) & ") As strCode," _
                    & "SUM(dblPostedDebit-dblPostedCredit) AS Amount " _
                    & "FROM ( " & strQAccountBalanceSql & " ) QAccountBalance,Account " _
                    & "WHERE QAccountBalance.lngAccountID=Account.lngAccountID "
                If mstrAccountSystem = "2" Or mstrAccountSystem = "3" Or mstrAccountSystem = "4" Or mstrAccountSystem = "5" Then
                    strSql = strSql & " AND (Account.lngAccountTypeID=" & atLoss & " OR Account.lngAccountTypeID=" & atCost & ") "
                Else
                    strSql = strSql & " AND Account.lngAccountTypeID=" & atLoss & " "
                End If
                strSql = strSql & " GROUP BY SUBSTR(strAccountCode,0," & Len(recZ!strAccountCode) & ") " _
                    & "HAVING Abs(SUM(dblPostedDebit-dblPostedCredit))>0.00001"
                Set recTmp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
                If Not recTmp.EOF Then
                    ValidPeriod = False
                End If
            End If
            If Not ValidPeriod Then
                Select Case mstrAccountSystem
                Case "1" '企业单位
                    Msg = "损益类科目未结平！"
                Case "2" '事业单位
                    Msg = "收入支出类科目未结平！"
                Case "3" '行政单位
                    Msg = "收入支出类科目未结平！"
                Case "4" '个体工商
                    Msg = "收支类科目未结平！"
                Case "5" '社会保险
                    Msg = "收入支出类科目未结平！"
                End Select
            End If
            recTmp.Close
        End If
    End If
    
    '是否有未执行的每期间(每季、每年)一次的通用转帐
    If ValidPeriod Then
        strSql = "SELECT * FROM TransVoucher WHERE strFrequency='1' AND " _
            & " strExecuteDate<'" & Format(dtmStart, "yyyy-mm-dd") & "'"
        If mintPeriod = mintPeriodNum Then
            gclsBase.GetBeginAndEndDate "本年", dtmStart, dtmStart, dtmEnd, True
            strSql = strSql & "OR strFrequency='2' AND strExecuteDate< '" & Format(dtmStart, "yyyy-mm-dd") & "'"
        End If
        Set recTmp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
        If Not recTmp.EOF Then
'            If mblnControl Then
'                ValidPeriod = False
'                Msg = "有本期必须转帐但未执行的通用转帐，不能结帐！"
'            Else
                mstrMsgVoucher = IIf(mstrMsgVoucher = "", "", mstrMsgVoucher & Chr(13) & Chr(10)) & "有本期须转帐但未执行的通用转帐！"
'            End If
        End If
        recTmp.Close
    End If
    
    '是否有凭证缺号
    If ValidPeriod And mblnControl And mintPeriod = mintPeriodNum Then
        strSql = "SELECT bytPeriod,lngVoucherTypeID,Count(*) As lngVoucherCnt,Max(intVoucherNO) As lngVoucherNO " _
            & "FROM Voucher WHERE intYear=" & mintYear & " GROUP BY bytPeriod,lngVoucherTypeID " _
            & "HAVING Count(*)<>Max(intVoucherNO)"
        Set recTmp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
        If Not recTmp.EOF Then
            Do While Not recTmp.EOF
                If Msg = "" Then
                    Msg = recTmp!bytPeriod & "月份"
                Else
                    Msg = Msg & "、" & recTmp!bytPeriod & "月份"
                End If
                recTmp.MoveNext
            Loop
            Msg = Msg & "存在凭证缺号，不能结帐！"
        End If
        recTmp.Close
    End If
    
    '本年利润科目是否转平
    If ValidPeriod And mintPeriod = mintPeriodNum And mstrAccountSystem = "1" Then
        lngID = CLng(GetSet(1, "损益结转", "本年利润", 0))
        If lngID > 0 Then
            strQAccountBalanceSql = TransferPublic.getQAccountBalanceOraSql(Format(mdtmEnd, "yyyy-mm-dd"))
            strSql = "SELECT Account.lngAccountID,strAccountCode,lngCustomerID,lngDepartmentID," _
                    & "lngEmployeeID,lngClassID1,lngClassID2,intDirection," _
                    & "SUM(dblPostedDebit-dblPostedCredit) AS Amount " _
                    & "FROM (" & strQAccountBalanceSql & " ) QAccountBalance,Account " _
                    & "WHERE QAccountBalance.lngAccountID=Account.lngAccountID(+) " _
                    & "AND InStr(Account.strAccountCode,'" & strCode & "')=1 " _
                    & "GROUP BY Account.lngAccountID,strAccountCode,lngCustomerID,lngDepartmentID," _
                    & "lngEmployeeID,lngClassID1,lngClassID2,intDirection " _
                    & "HAVING Abs(SUM(dblPostedDebit-dblPostedCredit))>0.00001"
            Set recTmp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
            If Not recTmp.EOF Then
                ValidPeriod = False
                Msg = "本年利润科目年末未分配完，不能结帐！"
            End If
        End If
    End If
    
    Set recTmp = Nothing
    Set recPeriod = Nothing
End Function