企业管理

开发平台：
Visual Basic

AccAssi.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 = "AccAssi"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Attribute VB_Ext_KEY = "SavedWithClassBuilder6" ,"Yes"
Attribute VB_Ext_KEY = "Top_Level" ,"Yes"
'****************************************************************
'*    模 块 名 称 :系统用于辅助核算中的查询
'*    功 能 描 述 :
'*    程序员姓名  :白石军
'*    最后修改人  :
'*    最后修改时间:2001/12/30
'*
'*    1。部门总帐
'*    2。个人余额表
'*    3。客户余额表
'*    4。供应商余额表
'*
'*    调用方法：在写入网格前
'*    Dim clsAccAss As New AccAssi
'*    With clsAccAss
'*      .iPeriod_Begin = Int_BPeriod  '查询会计期开始
'*      .iPeriod_End = Int_EPeriod    '查询会计期结束
'*      .iPeriod_Year = Int_Year      '查询会计年
'*      .b_Keep_Business_Records = Bln_IncluNotBook  '是否包含记帐凭证
'*      .PayTypes = Dep   '常量,Dep：部门，Per个人，Cur：客户，Ven：供应商
'*      .sPayCode = Str_FzCode  '部门、个人、客户或供应商代码，不分类。
'*    End With
'*    Set Rec_Query = clsAccAss.GetNewRs()
'*    最后在Form_UnLoad() 中销毁此对象 Set clsAccAssi=Nothing
'*    备        注:程序中所有依实际情况自定义部分均用[>>  <<]括起
'****************************************************************
Option Explicit
Const DEBUG_FLAG = True '调试标志，发布时设为False
Const FIRST_MEMBER = 1 '第一个成员，用于集合的循环变量
Const DEPT_CODE = &H100 '表示部门往来的常量
Const CURS_CODE = &H200 '表示客户往来的常量
Const VEND_CODE = &H300 '表示供应商往来的常量
Const PERS_CODE = &H400 '表示个人往来的常量
'-------------------------------------------
Const QI_CU_YU_E = &H500 '表示期初余额的常量
Const BEN_QI_FA_SHENG_E = &H600 '表示本期发生额的常量
Const LEI_JI_FA_SHENG_E = &H700 '表示累计发生额的常量
'-------------------------------------------
Public Enum Account_Book_Type '帐类型，如期初余额、期末余额等
    QiCu = QI_CU_YU_E '期初余额
    BenQi = BEN_QI_FA_SHENG_E '本期发生额
    LeiJi = LEI_JI_FA_SHENG_E '累计发生额
End Enum
'-------------------------------------------
Public Enum PAST_VALUE '用于传递参数据的数据类型
    Dep = DEPT_CODE '部门往来
    Cur = CURS_CODE '客户往来
    Per = PERS_CODE '个人往来
    Ven = VEND_CODE '供应商往来
End Enum
'------------------------------------------------------
Private AccType As Account_Book_Type  '类型，期初、期末、本期等
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 PayTypes As PAST_VALUE '辅助核算类型，如：部门往来、客户往来等
Public sPayCode As String '核算代码，如部门代码、客户代码等
'--------------------------------------------------------
Public PayRs As New ADODB.Recordset '核算基记录集，也是最终返回的记录集，可对其数值进行加减
Private AddRs As New ADODB.Recordset '相加记录集，将此记录集累加到基记录集上，几次累加后得到最终结果
'-------------------------------------------
Private sCodingPlan As String '科目编码方案
'---由于字段名可能不同，而此模块要应用于四个查询窗体，及数据表中，所以引入此法-----------
'   在 MeInit 过程中根据传递参数 AccType 设置这些值
Private CodeFlagFerldName As String 'Cwzz_AccCode（科目表）中标记往来的字段名
Private AssiCodeFeildName As String 'Cwzz_SumAssi（辅助帐）中标记往来代码的字段名
Private VouchCodeFeildName As String 'Cwzz_Vouch（凭证子表）中标记往来代码的字段名
'--------------------------------------------------------------------------------
Private CodeList As New Collection '用于存放会计科目列表的集合（最终数据）
Private TemCodeListAssi As New Collection '临时存放会计科目列表的集合
Private TemCodeListVouch As New Collection '临时存放会计科目列表的集合
Public Function GetNewRs() As ADODB.Recordset
    '公共接口
    '供外部程序调用的方法，并返回新的记录集
    If DEBUG_FLAG = False Then On Error Resume Next
    
    Call MeInit '初始化字段名
    
    Call GetAssiCodeList '取辅助核算表中有记录的科目列表
    
    If b_Keep_Business_Records = True Then '如果包含末记帐凭证
        Call GetVouchCodeList '则取凭证表中有发生的科目列表
    End If
    
    Call MakeCodeList '由临时集合1、2生成新的会计科目列表（集合中科目有唯一性）
    
    '------------生成期初数据------------------------------------
    AccType = QiCu '标记设为“期初”
    
    Call MakePayRs '生成基记录集
    
    Call GetSumAssi '生成期初数据
    Call AddTowRs '相加已取得的两个记录集
    
    
    If b_Keep_Business_Records = True Then '如果包含末记帐凭证
        Call GetVouchRs '则取末记帐凭证生成相加记录集
        Call AddTowRs '相加已取得的两个记录集
    End If
    '------------------------------------------------------------
    
    '------------生成本期发生数据--------------------------------
    AccType = BenQi '标记设为“本期”
    
    Call GetSumAssi '生成本期数据
    Call AddTowRs '相加已取得的两个记录集
    
    If b_Keep_Business_Records = True Then '如果包含末记帐凭证
        Call GetVouchRs '则取末记帐凭证生成相加记录集
        Call AddTowRs '相加已取得的两个记录集
    End If
    '--------------------------------------------------------------
    
    '--------------生成累计发生额----------------------------------
    AccType = LeiJi '标记设为“累计”
    
    Call GetSumAssi '生成累计数据
    Call AddTowRs '相加已取得的两个记录集
    
    If b_Keep_Business_Records = True Then '如果包含末记帐凭证
        Call GetVouchRs '则取末记帐凭证生成相加记录集
        Call AddTowRs '相加已取得的两个记录集
    End If
    '----------------------------
    
    Set GetNewRs = PayRs '返回最新的记录集
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 Class_Terminate()
    '销毁对象
    On Error Resume Next
    
    Set CodeList = Nothing
    Set TemCodeListAssi = Nothing
    Set TemCodeListVouch = Nothing
    
    If PayRs.State <> adStateClosed Then PayRs.Close
    If AddRs.State <> adStateClosed Then AddRs.Close
    
    Set PayRs = Nothing
    Set AddRs = Nothing
    
End Sub
Private Sub GetAssiCodeList() '取辅助核算表中有记录的科目列表
    '有过发生额的科目被取出，并存放于临时集合“TemCodeListAssi”中，
    '此集合中的科目将最终被加入到“CodeList”中用来生成查询语句
    '生成的查询语名格式为：cCode='xxx1" or cCode='xxx2" or cCode='xxx3" ……
    
    If DEBUG_FLAG = False Then On Error Resume Next
    Dim temRs As New ADODB.Recordset
    Dim strSql As String
    strSql = "SELECT DISTINCT cCode FROM Cwzz_AccSumAssi WHERE " & AssiCodeFeildName & " like '" & sPayCode & "%'"
    
    Set temRs = Cw_DataEnvi.DataConnect.Execute(strSql)
    
    With temRs
        If .EOF And .BOF Then Exit Sub
        
        Dim strCode As String
        Dim iLen As Integer
        Dim iCutLen As Integer
        Dim strTem As String
        Do Until .EOF
            '--根据编码方案取出科目代码及其上级科目代码---------
            strCode = Trim(!Ccode)
            iLen = 1
            iCutLen = 0
            Do While (iCutLen < Len(strCode))
                iCutLen = iCutLen + Mid(sCodingPlan, iLen, 1) 'sCodingPlan 为编码方案
                strTem = Left(strCode, iCutLen)
                TemCodeListAssi.Add Trim(strTem)
                iLen = iLen + 1
            Loop
            '-------------------------------------------------
            .MoveNext
        Loop
    End With
    temRs.Close
    Set temRs = Nothing
End Sub
Private Sub GetVouchCodeList() '则取凭证表中有发生的科目列表
    If DEBUG_FLAG = False Then On Error Resume Next
    Dim temRs As New ADODB.Recordset
    Dim strSql As String
    strSql = "SELECT DISTINCT cCode FROM Cwzz_AccVouchSub WHERE " & AssiCodeFeildName & " like '" & sPayCode & "%'"
    
    Set temRs = Cw_DataEnvi.DataConnect.Execute(strSql)
    
    With temRs
        If .EOF And .BOF Then Exit Sub
        
        Dim strCode As String
        Dim iLen As Integer
        Dim iCutLen As Integer
        Dim strTem As String
        Do Until .EOF
            '---------------------------------------------------
            strCode = Trim(!Ccode)
            iLen = 1
            iCutLen = 0
            Do While (iCutLen < Len(strCode))
                iCutLen = iCutLen + Mid(sCodingPlan, iLen, 1)
                strTem = Left(strCode, iCutLen)
                TemCodeListVouch.Add Trim(strTem)
                iLen = iLen + 1
            Loop
            '-------------------------------------------------
            .MoveNext
        Loop
    End With
    temRs.Close
    Set temRs = Nothing
End Sub
Private Sub MakeCodeList() '由临时集合1、2生成新的会计科目列表（集合中科目有唯一性）
    If DEBUG_FLAG = False Then On Error Resume Next
    Dim i As Integer
    Dim j As Integer
    Dim temRs As New ADODB.Recordset
    Dim strSql As String
    
    Dim bIsHere As Boolean
    '-----------------------------------------------------
    For i = FIRST_MEMBER To TemCodeListAssi.count
        bIsHere = False
        For j = FIRST_MEMBER To CodeList.count
            If CodeList.Item(j) = TemCodeListAssi.Item(i) Then
                bIsHere = True
                Exit For
            End If
        Next j
        
        If bIsHere = False Then
            CodeList.Add TemCodeListAssi.Item(i)
        End If
    Next i
    '-----------------------------------------------------
    For i = FIRST_MEMBER To TemCodeListVouch.count
        bIsHere = False
        For j = FIRST_MEMBER To CodeList.count
            If CodeList.Item(j) = TemCodeListVouch.Item(i) Then
                bIsHere = True
                Exit For
            End If
        Next j
        If bIsHere = False Then
            CodeList.Add TemCodeListVouch.Item(i)
        End If
        
    Next i
    
    For i = CodeList.count To FIRST_MEMBER Step -1
        strSql = "SELECT " & CodeFlagFerldName & " FROM Cwzz_AccCode WHERE cCode='" & CodeList.Item(i) & "'"
        If temRs.State <> adStateClosed Then temRs.Close
        Set temRs = Cw_DataEnvi.DataConnect.Execute(strSql)
        If temRs.Fields(CodeFlagFerldName).Value = False Then
            CodeList.Remove (i)
        End If
    Next
    
End Sub
Private Sub MakePayRs() '生成基记录集
    If DEBUG_FLAG = False Then On Error Resume Next
    Dim strTemSql As String
    Dim i As Integer
    strTemSql = ""
    strTemSql = "SELECT  Cwzz_AccCode.cCode," '    /* 科目代码 */
    strTemSql = strTemSql & "Cwzz_AccCode.cName," '   /* 科目名称*/
    strTemSql = strTemSql & "Cwzz_AccCode.EndFlag," '   /*末级标志*/
    strTemSql = strTemSql & "IsNull(Cwzz_AccSum.Period,1) as Period," '/*/
    
    strTemSql = strTemSql & "Cwzz_AccSum.Qcye as QcyeHj," ' /* 期初余额*/
    strTemSql = strTemSql & "Cwzz_AccSum.Qcsl as QcslHj," '/*期初数量*/
    strTemSql = strTemSql & "Cwzz_AccSum.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 & " From "
    strTemSql = strTemSql & " Cwzz_AccCode LEFT OUTER JOIN  Cwzz_AccSum ON "
    strTemSql = strTemSql & " Cwzz_AccCode.Ccode =Cwzz_AccSum.Ccode "
    strTemSql = strTemSql & " Where "
    If CodeList.count > 0 Then
        For i = FIRST_MEMBER To CodeList.count - 1
            strTemSql = strTemSql & " Cwzz_AccCode.cCode='" & CodeList.Item(i) & "' OR "
        Next
        
        strTemSql = strTemSql & " Cwzz_AccCode.cCode='" & CodeList.Item(i) & "'" '这样做是为了去除最后的“OR”
    Else
        strTemSql = strTemSql & "1=2"
    End If
    With PayRs
        .ActiveConnection = Cw_DataEnvi.DataConnect
        .Source = strTemSql
        .Open , , adOpenStatic, adLockBatchOptimistic
        Set .ActiveConnection = Nothing
        
        '删除多余的记录
        Do Until .EOF
            If !Period <> 1 Then
                .Delete
            Else
                '--------清空记录----------------
                !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
            End If
            '------------------------
            .MoveNext
        Loop
        If Not (.EOF And .BOF) Then
            .MoveFirst
        End If
    End With
End Sub
Private Sub GetVouchRs() '取末记帐凭证生成相加记录集
    '此过程根据“标志”来生成SQL语句
    If DEBUG_FLAG = False Then On Error Resume Next
    Dim strTemSql As String
    Dim i As Integer
    strTemSql = ""
    strTemSql = strTemSql & "SELECT cCode,"
    Select Case AccType  '此为全局变量
    Case QI_CU_YU_E '期初
        
        strTemSql = strTemSql & " (Sum(Jfje)-Sum(Dfje)) as QcyeHj,"
        strTemSql = strTemSql & " (Sum(Jfsl)-Sum(Dfsl)) as QcslHj,"
        strTemSql = strTemSql & " (Sum(wbJfje)-Sum(wbDfje)) as QcwbHj"
        strTemSql = strTemSql & " FROM Cwzz_AccVouchSub,Cwzz_AccVouchMain"
        strTemSql = strTemSql & " WHERE "
        strTemSql = strTemSql & " Cwzz_AccVouchMain.BookFlag=0 "
        strTemSql = strTemSql & " And Cwzz_AccVouchMain.VouchId=Cwzz_AccVouchSub.VouchId "
        strTemSql = strTemSql & " And Period<" & iPeriod_Begin
        strTemSql = strTemSql & " And Cwzz_AccVouchSub." & VouchCodeFeildName & " like '" & sPayCode & "%'"
        strTemSql = strTemSql & " group by cCode"
        strTemSql = strTemSql & ""
        
    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 " & VouchCodeFeildName & " like '" & sPayCode & "%'"
        strTemSql = strTemSql & " AND Cwzz_AccVouchMain.BookFlag=0 AND ("
        
        
    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 "
        '-----------------2001年7月26日 11：15 分修改 （bsj）--------------------------
        '问题：累计发生应为“查询期期末”以前的所有末记帐凭证，即小于“查询期期末”所有凭证
        '原程序为：“查询期期初”——“查询期期末”的所有凭证
        '此行为原程序：strTemSql = strTemSql & " AND Cwzz_AccVouchMain.Period BETWEEN " & iPeriod_Begin & " AND " & iPeriod_End
        '下一行为修改后程序：strTemSql = strTemSql & " AND Cwzz_AccVouchMain.Period <" & iPeriod_End
        strTemSql = strTemSql & " AND Cwzz_AccVouchMain.Period <" & iPeriod_End
        '---------------------修改结束-----------------------------------------
        strTemSql = strTemSql & " AND Cwzz_AccVouchMain.Year=" & iPeriod_Year
        strTemSql = strTemSql & " AND " & VouchCodeFeildName & " like '" & sPayCode & "%'"
        strTemSql = strTemSql & " AND Cwzz_AccVouchMain.BookFlag=0 AND ("
    End Select
    
    If AccType <> QiCu Then
        If CodeList.count > 0 Then
            For i = FIRST_MEMBER To CodeList.count - 1
                strTemSql = strTemSql & " Cwzz_AccVouchSub.cCode='" & CodeList.Item(i) & "' OR "
            Next
            strTemSql = strTemSql & " Cwzz_AccVouchSub.cCode='" & CodeList.Item(i) & "')" '这样做是为了去除最后的“OR”
        Else
            strTemSql = strTemSql & "1=2)"
        End If
        strTemSql = strTemSql & " Group By 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 GetSumAssi() '生成期初、本期发生、累计发生数据
    If DEBUG_FLAG = False Then On Error Resume Next
    Dim strTemSql As String
    Dim i As Integer
    strTemSql = ""
    strTemSql = "SELECT  Cwzz_AccSumAssi.cCode," '    /* 科目代码 */
    
    Select Case AccType '此变量为全局变量
    Case QI_CU_YU_E '期初
        strTemSql = strTemSql & "Qcye as QcyeHj," ' /* 期初余额*/
        strTemSql = strTemSql & "Qcsl as QcslHj," '/*期初数量*/
        strTemSql = strTemSql & "Qcwb as QcwbHj," '/*期初外币*/
        
        
        If Right(strTemSql, 1) = "," Then strTemSql = Left(strTemSql, Len(strTemSql) - 1)
        strTemSql = strTemSql & " From "
        strTemSql = strTemSql & " Cwzz_AccSumAssi "
        strTemSql = strTemSql & " Where "
        strTemSql = strTemSql & " Period = " & iPeriod_Begin & " AND Year=" & iPeriod_Year & " AND "
        strTemSql = strTemSql & AssiCodeFeildName & " like '" & sPayCode & "%' AND ("
        
    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," ' /*本月贷方累计数量合计*/
        
        If Right(strTemSql, 1) = "," Then strTemSql = Left(strTemSql, Len(strTemSql) - 1)
        strTemSql = strTemSql & " From "
        strTemSql = strTemSql & " Cwzz_AccSumAssi "
        strTemSql = strTemSql & " Where "
        strTemSql = strTemSql & " Period < " & iPeriod_End & " AND Year=" & iPeriod_Year & " AND "
        strTemSql = strTemSql & AssiCodeFeildName & " like '" & sPayCode & "%' AND ("
        
        
    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 " ' /*本期贷方外币发生额*/
        
        
        If Right(strTemSql, 1) = "," Then strTemSql = Left(strTemSql, Len(strTemSql) - 1)
        strTemSql = strTemSql & " From "
        strTemSql = strTemSql & " Cwzz_AccSumAssi "
        strTemSql = strTemSql & " Where "
        strTemSql = strTemSql & " Period BETWEEN " & iPeriod_Begin & " AND " & iPeriod_End & " AND Year=" & iPeriod_Year & " AND "
        strTemSql = strTemSql & AssiCodeFeildName & " like '" & sPayCode & "%' AND ("
        
    End Select
    
    If CodeList.count > 0 Then
        For i = FIRST_MEMBER To CodeList.count - 1
            strTemSql = strTemSql & " Cwzz_AccSumAssi.cCode='" & CodeList.Item(i) & "' OR "
        Next
        strTemSql = strTemSql & " Cwzz_AccSumAssi.cCode='" & CodeList.Item(i) & "')" '这样做是为了去除最后的“OR”
    Else
        strTemSql = strTemSql & "1=2)"
    End If
    If AccType = BenQi Then
        strTemSql = strTemSql & " Group By 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 AddSingle() '相加已取得的两个记录集
    If DEBUG_FLAG = False Then On Error Resume Next
    Select Case AccType
    Case QI_CU_YU_E '期初
        PayRs!QcyeHj = PayRs!QcyeHj + IIf(IsNull(AddRs!QcyeHj), 0, AddRs!QcyeHj)
        PayRs!QcslHj = PayRs!QcslHj + IIf(IsNull(AddRs!QcslHj), 0, AddRs!QcslHj)
        PayRs!QcwbHj = PayRs!QcwbHj + IIf(IsNull(AddRs!QcwbHj), 0, AddRs!QcwbHj)
        PayRs.Update
    Case BEN_QI_FA_SHENG_E '本期发生
        PayRs!Mjjehj = PayRs!Mjjehj + IIf(IsNull(AddRs!Mjjehj), 0, AddRs!Mjjehj) ' /* 本期借方发生额*/"
        PayRs!Mdjehj = PayRs!Mdjehj + IIf(IsNull(AddRs!Mdjehj), 0, AddRs!Mdjehj) ' /*本期借方数量发生额*/"
        PayRs!Mjslhj = PayRs!Mjslhj + IIf(IsNull(AddRs!Mjslhj), 0, AddRs!Mjslhj) ' /*本期借方外币发生额*/"
        PayRs!Mdslhj = PayRs!Mdslhj + IIf(IsNull(AddRs!Mdslhj), 0, AddRs!Mdslhj) ' /* 本期贷方发生额*/"
        PayRs!Mjwbhj = PayRs!Mjwbhj + IIf(IsNull(AddRs!Mjwbhj), 0, AddRs!Mjwbhj) ' /*本期贷方数量发生额*/"
        PayRs!Mdwbhj = PayRs!Mdwbhj + IIf(IsNull(AddRs!Mdwbhj), 0, AddRs!Mdwbhj) ' /*本期贷方外币发生额*/"
        PayRs.Update
    Case LEI_JI_FA_SHENG_E '累计发生
        PayRs!ByjfljjeHj = PayRs!ByjfljjeHj + IIf(IsNull(AddRs!ByjfljjeHj), 0, AddRs!ByjfljjeHj)
        PayRs!BydfljjeHj = PayRs!BydfljjeHj + IIf(IsNull(AddRs!BydfljjeHj), 0, AddRs!BydfljjeHj)
        PayRs!ByjfljslHj = PayRs!ByjfljslHj + IIf(IsNull(AddRs!ByjfljslHj), 0, AddRs!ByjfljslHj)
        PayRs!BydfljslHj = PayRs!BydfljslHj + IIf(IsNull(AddRs!BydfljslHj), 0, AddRs!BydfljslHj)
        PayRs!ByjfljwbHj = PayRs!ByjfljwbHj + IIf(IsNull(AddRs!ByjfljwbHj), 0, AddRs!ByjfljwbHj)
        PayRs!BydfljwbHj = PayRs!BydfljwbHj + IIf(IsNull(AddRs!BydfljwbHj), 0, AddRs!BydfljwbHj)
        PayRs.Update
    End Select
End Sub
Private Sub MeInit() '初始化字段名
    If DEBUG_FLAG = False Then On Error Resume Next
    Select Case PayTypes
    Case DEPT_CODE '部门
        CodeFlagFerldName = "DeptFlag"
        AssiCodeFeildName = "DeptCode"
        VouchCodeFeildName = "DeptCode"
    Case CURS_CODE '客户
        CodeFlagFerldName = "CusFlag"
        AssiCodeFeildName = "CusCode"
        VouchCodeFeildName = "CusCode"
    Case VEND_CODE '供应商
        CodeFlagFerldName = "SupplierFlag"
        AssiCodeFeildName = "SupplierCode"
        VouchCodeFeildName = "SupplierCode"
    Case PERS_CODE '个人
        CodeFlagFerldName = "PersonFlag"
        AssiCodeFeildName = "PersonCode"
        VouchCodeFeildName = "PersonCode"
    End Select
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)书签
    
    With PayRs
        If Not (.BOF And .EOF) Then
            myBookMark = .Bookmark '保存记录书签
            .MoveFirst
            .Find "cCode='" & strParend & "'"
            If Not .EOF Then
                Call AddSingle
            End If
            .Bookmark = myBookMark
        End If
        
    End With
End Sub

						