企业管理

开发平台：
Visual Basic

AccSum.cls：源码内容
							VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "AccSum"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
'****************************************************************
'*    模 块 名 称 :系统总帐查询的类模块
'*    功 能 描 述 :
'*    程序员姓名  :白石军
'*    最后修改人  :
'*    最后修改时间:2001/12/30
'*    调用方法：
'*     Dim clsAccSum As New AccSum
'*     With clsAccSum
'*       .iGrade_Begin = Val(ZB_Frmkmyebtj.LrText(2).Text)
'*       .iGrade_End = Val(ZB_Frmkmyebtj.LrText(3).Text)
'*       .sCode_Begin = Trim(ZB_Frmkmyebtj.LrText(0).Text)
'*       .sCode_End = Trim(ZB_Frmkmyebtj.LrText(1).Text)
'*       .sClass = Trim(ZB_Frmkmyebtj.Combo_Class.Text)
'*       .iPeriod_Begin = Int_BPeriod
'*       .iPeriod_End = Int_EPeriod
'*       .iPeriod_Year = Int_Year
'*       .b_Keep_Business_Records = Bln_IncluNotBook
'*     End With
'*     Set Rec_Query = clsAccSum.GetNewRs
'*    在 Form_UnLoad 中销毁对象 Set clsAccSum=Nothing
'*    备        注:程序中所有依实际情况自定义部分均用[>>  <<]括起
'****************************************************************
Option Explicit
Const DEBUG_FLAG = True '调试标志，发布时设为False
Const QI_CU_YU_E = &H500 '表示期初余额的常量
Const BEN_QI_FA_SHENG_E = &H600 '表示本期发生额的常量
Const LEI_JI_FA_SHENG_E = &H700 '表示累计发生额的常量
Public SumRs As New ADODB.Recordset '核算基记录集，也是最终返回的记录集，可对其数值进行加减
Private AddRs As New ADODB.Recordset '相加记录集，将此记录集累加到基记录集上，几次累加后得到最终结果
Public iPeriod_Begin As Integer '起始会计期间
Public iPeriod_End As Integer '终止会计期间
Public iPeriod_Year As Integer '会计年度
Public b_Keep_Business_Records As Boolean '是否包含末记帐凭证 True包含,False不包含
Public sCode_Begin As String  '起始会计科目
Public sCode_End As String  '终止会计科目
Public iGrade_Begin As Integer '起始科目级次
Public iGrade_End As Integer  '终止科目级次
Public sClass As String  '科目类型
Private sCodingPlan As String '科目编码方案
Private Enum Account_Book_Type '帐类型，如期初余额、期末余额等
    QiCu = QI_CU_YU_E '期初余额
    BenQi = BEN_QI_FA_SHENG_E '本期发生额
    LeiJi = LEI_JI_FA_SHENG_E '累计发生额
End Enum
Private AccType As Account_Book_Type  '类型，期初、期末、本期等
Public Function GetNewRs() As ADODB.Recordset
    '供外部程序调用的方法，并返回新的记录集
    
    '------------生成期初数据------------------------------------
    AccType = QiCu '标记设为“期初”
    
    Call MakePayRs '生成基记录集
    
    Call GetSum '生成期初数据
    Call AddTowRsNew '相加已取得的两个记录集
    
    If b_Keep_Business_Records = True Then '如果包含末记帐凭证
        Call GetVouchRs '则取末记帐凭证生成相加记录集
        Call AddTowRs '相加已取得的两个记录集
    End If
    '------------------------------------------------------------
    
    '------------生成本期发生数据--------------------------------
    AccType = BenQi '标记设为“本期”
    
    Call GetSum '生成本期数据
    Call AddTowRsNew '相加已取得的两个记录集
    
    If b_Keep_Business_Records = True Then '如果包含末记帐凭证
        Call GetVouchRs '则取末记帐凭证生成相加记录集
        Call AddTowRs '相加已取得的两个记录集
    End If
    '--------------------------------------------------------------
    
    '--------------生成累计发生额----------------------------------
    AccType = LeiJi '标记设为“累计”
    
    Call GetSum '生成累计数据
    Call AddTowRsNew '相加已取得的两个记录集
    
    If b_Keep_Business_Records = True Then '如果包含末记帐凭证
        Call GetVouchRs '则取末记帐凭证生成相加记录集
        Call AddTowRs '相加已取得的两个记录集
    End If
    '----------------------------
    
    Set GetNewRs = SumRs '返回最新的记录集
End Function
Private Sub Class_Initialize()
    '取得科目代码编码方案
    If DEBUG_FLAG = False Then On Error Resume Next
    
    Dim temRs As ADODB.Recordset
    Set temRs = Cw_DataEnvi.DataConnect.Execute("select * from Gy_CodeScheme where ItemCode='Cwzz_Kmcode'")
    sCodingPlan = Trim(temRs!codescheme)
    temRs.Close
    Set temRs = Nothing
End Sub
Private Sub MakePayRs()
    If DEBUG_FLAG = False Then On Error Resume Next
    Dim strTemSql As String
    strTemSql = ""
    strTemSql = "SELECT  Cwzz_AccCode.cCode," '    /* 科目代码 */
    strTemSql = strTemSql & "Cwzz_AccCode.cName," '   /* 科目名称*/
    strTemSql = strTemSql & "Cwzz_AccCode.cClass," '   /* 科目类型*/
    strTemSql = strTemSql & "Cwzz_AccCode.CodeLevel," '    /*科目级次 */
    strTemSql = strTemSql & "Cwzz_AccCode.EndFlag," '   /*末级标志*/
    strTemSql = strTemSql & "Cwzz_AccCode.ForeignFlag," '  /*外币核算标志*/
    strTemSql = strTemSql & "Cwzz_AccCode.BalanceOri," '  /* 余额方向*/
    strTemSql = strTemSql & "Cwzz_AccCode.ParentCode," '/*上级科目代码*/
    strTemSql = strTemSql & "IsNull(Period,0) As Period," '/*上级科目代码*/
    
    strTemSql = strTemSql & "Qcye as QcyeHj," ' /* 期初余额*/
    strTemSql = strTemSql & "Qcsl as QcslHj," '/*期初数量*/
    strTemSql = strTemSql & "Qcwb as QcwbHj," '/*期初外币*/
    
    strTemSql = strTemSql & "Byjfljje as ByjfljjeHj," ' /*本月借方累计金额合计*/
    strTemSql = strTemSql & "Bydfljje as BydfljjeHj," ' /*本月贷方累计金额合计*/
    strTemSql = strTemSql & "Byjfljwb as ByjfljwbHj," ' /*本月借方累计外币合计*/
    strTemSql = strTemSql & "Bydfljwb as BydfljwbHj," ' /*本月贷方累计外币合计*/
    strTemSql = strTemSql & "Byjfljsl as ByjfljslHj," ' /*本月借方累计数量合计*/
    strTemSql = strTemSql & "Bydfljsl as BydfljslHj," ' /*本月贷方累计数量合计*/
    
    strTemSql = strTemSql & "Mjje as Mjjehj," ' /* 本期借方发生额*/
    strTemSql = strTemSql & "Mjsl as Mjslhj," ' /*本期借方数量发生额*/
    strTemSql = strTemSql & "Mjwb as Mjwbhj," ' /*本期借方外币发生额*/
    strTemSql = strTemSql & "Mdje as Mdjehj," ' /* 本期贷方发生额*/
    strTemSql = strTemSql & "Mdsl as Mdslhj," ' /*本期贷方数量发生额*/
    strTemSql = strTemSql & "Mdwb as Mdwbhj," ' /*本期贷方外币发生额*/
    
    strTemSql = strTemSql & "Xt_combolist.Item_Index "
    
    strTemSql = strTemSql & " From Cwzz_AccCode "
    strTemSql = strTemSql & " LEFT OUTER JOIN Cwzz_AccSum "
    strTemSql = strTemSql & " ON Cwzz_AccCode.cCode=Cwzz_AccSum.cCode "
    strTemSql = strTemSql & " AND Period=" & iPeriod_Begin
    strTemSql = strTemSql & " AND Year=" & iPeriod_Year
    strTemSql = strTemSql & " LEFT OUTER JOIN "
    strTemSql = strTemSql & " Xt_combolist ON Cwzz_AccCode.CClass = Xt_combolist.item_content  "
    strTemSql = strTemSql & " AND Xt_combolist.combo_code='Cwzz_kmlx' "
    strTemSql = strTemSql & " AND Xt_combolist.system_code='cwzz' "
    strTemSql = strTemSql & " Where "
    strTemSql = strTemSql & " codelevel BETWEEN '" & iGrade_Begin & "' AND '" & iGrade_End & "' "
    
    If sCode_Begin <> "" And sCode_End <> "" Then
        strTemSql = strTemSql & " AND Cwzz_AccCode.cCode>='" & sCode_Begin & "' AND Cwzz_AccCode.cCode<='" & sCode_End & "' "
    ElseIf sCode_Begin <> "" And sCode_End = "" Then
        strTemSql = strTemSql & " AND Cwzz_AccCode.cCode>='" & sCode_Begin & "' "
    ElseIf sCode_Begin = "" And sCode_End <> "" Then
        strTemSql = strTemSql & " AND Cwzz_AccCode.cCode<='" & sCode_End & "' "
    End If
    
    If sClass <> "" Then
        strTemSql = strTemSql & " AND Cwzz_AccCode.cClass='" & sClass & "' "
    End If
    
    With SumRs
        If .State <> adStateClosed Then .Close
        .ActiveConnection = Cw_DataEnvi.DataConnect
        .Source = strTemSql
        .Open , , adOpenStatic, adLockBatchOptimistic
        Set .ActiveConnection = Nothing
        
        
        Do Until .EOF
            !QcyeHj = 0
            !QcslHj = 0
            !QcwbHj = 0
            
            !Mjjehj = 0
            !Mdjehj = 0
            !Mjslhj = 0
            !Mdslhj = 0
            !Mjwbhj = 0
            !Mdwbhj = 0
            
            !ByjfljjeHj = 0
            !BydfljjeHj = 0
            !ByjfljwbHj = 0
            !BydfljwbHj = 0
            !ByjfljslHj = 0
            !BydfljslHj = 0
            .Update
            .MoveNext
        Loop
        If Not (.EOF And .BOF) Then
            .MoveFirst
        End If
    End With
    
    
End Sub
Private Sub Class_Terminate()
    If DEBUG_FLAG = False Then On Error Resume Next
    
    If SumRs.State <> adStateClosed Then SumRs.Close
    If AddRs.State <> adStateClosed Then AddRs.Close
    
    Set SumRs = Nothing
    Set AddRs = Nothing
End Sub
Private Sub GetSum()
    If DEBUG_FLAG = False Then On Error Resume Next
    
    Dim strTemSql As String
    Dim i As Integer
    strTemSql = ""
    strTemSql = "SELECT  Cwzz_AccSum.cCode," '    /* 科目代码 */
    
    Select Case AccType
    Case QI_CU_YU_E '期初
        strTemSql = strTemSql & "IsNull(Qcye,0) as QcyeHj," '/*期初余额*/
        strTemSql = strTemSql & "IsNull(Qcsl,0) as QcslHj," '/*期初数量*/
        strTemSql = strTemSql & "IsNull(Qcwb,0) as QcwbHj," '/*期初外币*/
    Case BEN_QI_FA_SHENG_E  '本期发生
        strTemSql = strTemSql & "Sum(Mjje) as Mjjehj," ' /*本期借方发生额*/
        strTemSql = strTemSql & "Sum(Mjsl) as Mjslhj," ' /*本期借方数量发生额*/
        strTemSql = strTemSql & "Sum(Mjwb) as Mjwbhj," ' /*本期借方外币发生额*/
        strTemSql = strTemSql & "Sum(Mdje) as Mdjehj," ' /*本期贷方发生额*/
        strTemSql = strTemSql & "Sum(Mdsl) as Mdslhj," ' /*本期贷方数量发生额*/
        strTemSql = strTemSql & "Sum(Mdwb) as Mdwbhj " ' /*本期贷方外币发生额*/
    Case LEI_JI_FA_SHENG_E '  累计发生
        strTemSql = strTemSql & "Byjfljje as ByjfljjeHj," ' /*本月借方累计金额合计*/
        strTemSql = strTemSql & "Bydfljje as BydfljjeHj," ' /*本月贷方累计金额合计*/
        strTemSql = strTemSql & "Byjfljwb as ByjfljwbHj," ' /*本月借方累计外币合计*/
        strTemSql = strTemSql & "Bydfljwb as BydfljwbHj," ' /*本月贷方累计外币合计*/
        strTemSql = strTemSql & "Byjfljsl as ByjfljslHj," ' /*本月借方累计数量合计*/
        strTemSql = strTemSql & "Bydfljsl as BydfljslHj," ' /*本月贷方累计数量合计*/
    End Select
    If Right(strTemSql, 1) = "," Then strTemSql = Left(strTemSql, Len(strTemSql) - 1)
    strTemSql = strTemSql & " From "
    strTemSql = strTemSql & " Cwzz_AccSum "
    strTemSql = strTemSql & " RIGHT OUTER JOIN Cwzz_AccCode "
    strTemSql = strTemSql & " ON Cwzz_AccSum.cCode=Cwzz_AccCode.cCode "
    strTemSql = strTemSql & " AND CodeLevel BETWEEN '" & iGrade_Begin & "' AND '" & iGrade_End & "' "
    
    If sCode_Begin <> "" And sCode_End <> "" Then
        strTemSql = strTemSql & " AND Cwzz_AccCode.cCode>='" & sCode_Begin & "' AND Cwzz_AccCode.cCode<='" & sCode_End & "' "
    ElseIf sCode_Begin <> "" And sCode_End = "" Then
        strTemSql = strTemSql & " AND Cwzz_AccCode.cCode>='" & sCode_Begin & "' "
    ElseIf sCode_Begin = "" And sCode_End <> "" Then
        strTemSql = strTemSql & " AND Cwzz_AccCode.cCode<='" & sCode_End & "' "
    End If
    
    If sClass <> "" Then
        strTemSql = strTemSql & " AND Cwzz_AccCode.cClass='" & sClass & "' "
    End If
    
    
    
    strTemSql = strTemSql & " Where "
    
    If AccType = QiCu Then
        strTemSql = strTemSql & " Period = " & iPeriod_Begin & " AND Year=" & iPeriod_Year & " "
    ElseIf AccType = BenQi Then
        strTemSql = strTemSql & " Period BETWEEN " & iPeriod_Begin & " AND " & iPeriod_End & " AND Year=" & iPeriod_Year & " "
    ElseIf AccType = LeiJi Then
        strTemSql = strTemSql & " Period = " & iPeriod_End & " AND Year=" & iPeriod_Year & " "
    End If
    
    strTemSql = strTemSql & " "
    
    If AccType = BenQi Then
        strTemSql = strTemSql & " Group By Cwzz_AccSum.cCode"
    End If
    With AddRs
        If .State <> adStateClosed Then .Close
        .ActiveConnection = Cw_DataEnvi.DataConnect
        .Source = strTemSql
        .Open , , adOpenStatic, adLockBatchOptimistic
        Set .ActiveConnection = Nothing
    End With
End Sub
Private Sub GetVouchRs()
    If DEBUG_FLAG = False Then On Error Resume Next
    
    Dim strTemSql As String
    Dim i As Integer
    strTemSql = ""
    strTemSql = strTemSql & "SELECT Cwzz_AccVouchSub.cCode,"
    Select Case AccType
    Case QI_CU_YU_E '期初
        strTemSql = strTemSql & " (Sum(Jfje)-Sum(Dfje)) as Qcye,"
        strTemSql = strTemSql & " (Sum(Jfsl)-Sum(Dfsl)) as Qcsl,"
        strTemSql = strTemSql & " (Sum(wbJfje)-Sum(wbDfje)) as Qcwb"
        strTemSql = strTemSql & " FROM "
        strTemSql = strTemSql & " Cwzz_AccVouchSub "
        strTemSql = strTemSql & " ,Cwzz_AccVouchMain "
        
        strTemSql = strTemSql & " WHERE "
        strTemSql = strTemSql & " Cwzz_AccVouchMain.Period<" & iPeriod_Begin
        strTemSql = strTemSql & " AND Cwzz_AccVouchMain.Year=" & iPeriod_Year
        strTemSql = strTemSql & " AND Cwzz_AccVouchMain.BookFlag=0 "
        
    Case BEN_QI_FA_SHENG_E      '本期发生
        strTemSql = strTemSql & "Sum(jfje) as Mjjehj," ' /* 本期借方发生额*/
        strTemSql = strTemSql & "Sum(jfsl) as Mjslhj," ' /*本期借方数量发生额*/
        strTemSql = strTemSql & "Sum(wbjfje) as Mjwbhj," ' /*本期借方外币发生额*/
        strTemSql = strTemSql & "Sum(dfje) as Mdjehj," ' /* 本期贷方发生额*/
        strTemSql = strTemSql & "Sum(dfsl) as Mdslhj," ' /*本期贷方数量发生额*/
        strTemSql = strTemSql & "Sum(wbdfje) as Mdwbhj " ' /*本期贷方外币发生额*/
        strTemSql = strTemSql & " FROM Cwzz_AccVouchSub,Cwzz_AccVouchMain"
        strTemSql = strTemSql & " WHERE "
        strTemSql = strTemSql & " Cwzz_AccVouchSub.VouchId=Cwzz_AccVouchMain.VouchId "
        strTemSql = strTemSql & " AND Cwzz_AccVouchMain.Period BETWEEN " & iPeriod_Begin & " AND " & iPeriod_End
        strTemSql = strTemSql & " AND Cwzz_AccVouchMain.Year=" & iPeriod_Year
        strTemSql = strTemSql & " AND Cwzz_AccVouchMain.BookFlag=0 "
        strTemSql = strTemSql & " AND Cwzz_AccVouchMain.Period BETWEEN " & iPeriod_Begin & " AND " & iPeriod_End
        strTemSql = strTemSql & " AND Cwzz_AccVouchMain.Year=" & iPeriod_Year
        
    Case LEI_JI_FA_SHENG_E      '累计发生
        strTemSql = strTemSql & "Sum(jfje) as ByjfljjeHj," ' /*本月借方累计金额合计*/
        strTemSql = strTemSql & "Sum(dfje) as BydfljjeHj," ' /*本月贷方累计金额合计*/
        strTemSql = strTemSql & "Sum(jfsl) as ByjfljwbHj," ' /*本月借方累计外币合计*/
        strTemSql = strTemSql & "Sum(dfsl) as BydfljwbHj," ' /*本月贷方累计外币合计*/
        strTemSql = strTemSql & "Sum(wbjfje) as ByjfljslHj," ' /*本月借方累计数量合计*/
        strTemSql = strTemSql & "Sum(wbdfje) as BydfljslHj" ' /*本月贷方累计数量合计*/
        strTemSql = strTemSql & " FROM Cwzz_AccVouchSub,Cwzz_AccVouchMain"
        strTemSql = strTemSql & " WHERE "
        strTemSql = strTemSql & " Cwzz_AccVouchSub.VouchId=Cwzz_AccVouchMain.VouchId "
        strTemSql = strTemSql & " AND Cwzz_AccVouchMain.Period BETWEEN " & iPeriod_Begin & " AND " & iPeriod_End
        strTemSql = strTemSql & " AND Cwzz_AccVouchMain.Year=" & iPeriod_Year
        strTemSql = strTemSql & " AND Cwzz_AccVouchMain.BookFlag=0 "
    End Select
    
    strTemSql = strTemSql & " Group By Cwzz_AccVouchSub.cCode"
    
    With AddRs
        If .State <> adStateClosed Then .Close
        .ActiveConnection = Cw_DataEnvi.DataConnect
        .Source = strTemSql
        .Open , , adOpenStatic, adLockBatchOptimistic
        Set .ActiveConnection = Nothing
    End With
End Sub
'===============================================================================
Private Sub AddSingleNew()
    If DEBUG_FLAG = False Then On Error Resume Next
    'AddSingle 的相似过程序，与AddSingle不同的是，不累加上级科目
    '所以累加语句被注消
    With SumRs
        Select Case AccType
        Case QI_CU_YU_E
            !QcyeHj = !QcyeHj + AddRs!QcyeHj
            !QcslHj = !QcslHj + AddRs!QcslHj
            !QcwbHj = !QcwbHj + AddRs!QcwbHj
            .Update
        Case BEN_QI_FA_SHENG_E
            !Mjjehj = !Mjjehj + AddRs!Mjjehj '本期发生借方金额
            !Mdjehj = !Mdjehj + AddRs!Mdjehj '本期发生贷方金额
            !Mjslhj = !Mjslhj + AddRs!Mjslhj '本期发生借方数量
            !Mdslhj = !Mdslhj + AddRs!Mdslhj '本期发生贷方数量
            !Mjwbhj = !Mjwbhj + AddRs!Mjwbhj '本期发生借方外币
            !Mdwbhj = !Mdwbhj + AddRs!Mdwbhj '本期发生贷方外币
            .Update
        Case LEI_JI_FA_SHENG_E
            !ByjfljjeHj = !ByjfljjeHj + AddRs!ByjfljjeHj ' /*本月借方累计金额合计*/"
            !BydfljjeHj = !BydfljjeHj + AddRs!BydfljjeHj ' /*本月贷方累计金额合计*/"
            !ByjfljwbHj = !ByjfljwbHj + AddRs!ByjfljwbHj ' /*本月借方累计外币合计*/"
            !BydfljwbHj = !BydfljwbHj + AddRs!BydfljwbHj ' /*本月贷方累计外币合计*/"
            !ByjfljslHj = !ByjfljslHj + AddRs!ByjfljslHj ' /*本月借方累计数量合计*/"
            !BydfljslHj = !BydfljslHj + AddRs!BydfljslHj ' /*本月贷方累计数量合计*/"
            .Update
        End Select
    End With
End Sub
Sub AddTowRsNew()
    '与AddTowRsNew 相似，不同的是，此过程直接相加，
    '不累加上级科目
    If DEBUG_FLAG = False Then On Error Resume Next
    
    Dim strTemParent As String
    With AddRs
        If Not (.EOF And .BOF) Then
            .MoveFirst
            Do Until .EOF
                strTemParent = Trim(!Ccode)
                If strTemParent <> "" Then SeachParentNew (strTemParent)
                .MoveNext
            Loop
        End If
    End With
End Sub
Private Sub SeachParentNew(strParend As String)
    '查询上级科目
    
    If DEBUG_FLAG = False Then On Error Resume Next
    
    With SumRs
        If Not (.BOF And .EOF) Then
            .MoveFirst
            .Find "cCode='" & strParend & "'"
            If Not .EOF Then
                Call AddSingleNew
            End If
        End If
        
    End With
End Sub
Sub AddSingle()
    '汇总一条记录到上级科目
    '此模块被SeachParent 调用
    '1.汇总记录
    '2.科目级次是否为1
    '  2.1如果为1则无上级科目，过程结束
    '  2.2不为1则继续查询上级科目，调用SeachParent过程
    '3.结束
    
    If DEBUG_FLAG = False Then On Error Resume Next
    
    With SumRs
        Select Case AccType
        Case QI_CU_YU_E
            !QcyeHj = !QcyeHj + AddRs!Qcye
            !QcslHj = !QcslHj + AddRs!Qcsl
            !QcwbHj = !QcwbHj + AddRs!Qcwb
            .Update
        Case BEN_QI_FA_SHENG_E
            !Mjjehj = !Mjjehj + AddRs!Mjjehj '本期发生借方金额
            !Mdjehj = !Mdjehj + AddRs!Mdjehj '本期发生贷方金额
            !Mjslhj = !Mjslhj + AddRs!Mjslhj '本期发生借方数量
            !Mdslhj = !Mdslhj + AddRs!Mdslhj '本期发生贷方数量
            !Mjwbhj = !Mjwbhj + AddRs!Mjwbhj '本期发生借方外币
            !Mdwbhj = !Mdwbhj + AddRs!Mdwbhj '本期发生贷方外币
            .Update
        Case LEI_JI_FA_SHENG_E
            !ByjfljjeHj = !ByjfljjeHj + AddRs!ByjfljjeHj ' /*本月借方累计金额合计*/"
            !BydfljjeHj = !BydfljjeHj + AddRs!BydfljjeHj ' /*本月贷方累计金额合计*/"
            !ByjfljwbHj = !BydfljwbHj + AddRs!BydfljwbHj ' /*本月借方累计外币合计*/"
            !BydfljwbHj = !BydfljwbHj + AddRs!BydfljwbHj ' /*本月贷方累计外币合计*/"
            !ByjfljslHj = !BydfljslHj + AddRs!BydfljslHj ' /*本月借方累计数量合计*/"
            !BydfljslHj = !BydfljslHj + AddRs!BydfljslHj ' /*本月贷方累计数量合计*/"
            
            
            .Update
        End Select
        If Val(!CodeLevel) > 1 Then SeachParent (Trim(!ParentCode))
    End With
End Sub
Sub AddTowRs()
    '相加科目总帐记录集与末记帐凭证记录集
    '此模块被MakeRs调用
    '如果此记录为顶级科目，则继续对下一条记录进行累加，
    '否则追朔查询上级科目
    
    If DEBUG_FLAG = False Then On Error Resume Next
    
    Dim strTemParent As String
    With AddRs
        If Not (.EOF And .BOF) Then
            .MoveFirst
            Do Until .EOF
                strTemParent = Trim(!Ccode)
                If strTemParent <> "" Then SeachParent (strTemParent)
                .MoveNext
            Loop
        End If
    End With
End Sub
Sub SeachParent(strParend As String)
    '查询上级科目
    '此模块被AddTowRs 调用
    '1.保存记录书签
    '2.根据strParend在Rec_Query中找到myTemRs当前记录的上级科目位置
    '3.汇总记录，调用AddSingle
    '4.恢复书签
    
    If DEBUG_FLAG = False Then On Error Resume Next
    
    Dim myBookMark  '用于保存记录集(Rec_Query)书签
    Dim temRs As New ADODB.Recordset
    With SumRs
        If Not (.BOF And .EOF) Then
            myBookMark = .Bookmark '保存记录书签
            .MoveFirst
            .Find "cCode='" & strParend & "'"
            If Not .EOF Then
                Call AddSingle
            Else
                .MoveFirst
                With temRs
                    If .State <> adStateClosed Then .Close
                    .ActiveConnection = Cw_DataEnvi.DataConnect
                    .Source = "select * from Cwzz_AccCode WHERE cCode='" & strParend & "'"
                    .Open , , adOpenStatic, adLockBatchOptimistic
                    Set .ActiveConnection = Nothing
                End With
                If Not (temRs.EOF And temRs.BOF) Then
                    If temRs!CodeLevel > 1 Then
                        strParend = temRs!ParentCode
                        .Find "cCode='" & strParend & "'"
                        If Not .EOF Then
                            Call AddSingle
                        End If
                    End If
                Else
                    MsgBox "发现科目表中有缺少科目！" & Chr(13) & Chr(13) & "科目代码为：" & strParend, vbCritical, "系统提示"
                End If
            End If
            .Bookmark = myBookMark
        End If
        
    End With
End Sub
'===============================================================================

						