i-

来自「VB开发的ERP系统」· 代码 · 共 1,236 行 · 第 1/5 页

'*    功 能 描 述 :本功能用于查询统计各级科目的本期发生额、累计
'*                 发生额和余额等。余额表则可输出某月或某几个月
'*                 的所有总帐科目或明细科目的期初余额、本期发生
'*                 额、累计发生额、期末余额。并支持包含未记帐凭
'*                 证查询。
'*    程序员姓名  : 张建忠
'*    最后修改人  : 奚俊峰
'*    最后修改时间: 2001-12-29
'*    备        注:程序中所有依实际情况自定义部分均用[>>  <<]括起
'*********************************************************************
'=====================变量声明区=======================================bsj==
Const FIRST_ACC_ADD = 0  '期初相加
Const BEN_QI = 1  '本期相加
Const LEI_JI = 2  '累计相加
Dim iAddState As Integer   '记录集相加标识
Dim temRs As New ADODB.Recordset  '临时
Dim Rec_Query As New ADODB.Recordset        '查询结果动态集
Dim iPeriodStar As Integer, iPeriodEnd As Integer '会计期间
Dim sCodeStar As String, sCodeEnd As String  '会计科目代码
Dim iGradeStar As Integer, iGradeEnd As Integer  '科目级次
Dim sClass As String  '科目类型
'===========================================================================
Dim ReportTitle As String                '报表主标题
Dim Bln_ClassSum As Boolean              '是否进行科目类别合计

'以下为固定使用变量
Dim Dyymctbl As New DY_Dyymsz            '打印页面窗体变量
Dim GridCode As String                   '显示网格网格代码
Dim GridInf() As Variant                 '整个网格设置信息
Dim Tsxx As String                       '系统提示信息
Dim Qslz As Long                         '网格隐藏(非操作显示)列数
Dim Sjhgd As Double                      '网格数据行高度
Dim Sfxshjwg As Boolean                  '是否显示合计网格
Dim GridBoolean() As Boolean             '网格列信息(布尔型)
Dim GridStr()  As String                 '网格列信息(字符型)
Dim GridInt() As Integer                 '网格列信息(整型)
Dim Szzls As Integer                     '数组总列数(网格列数-1)
Dim Bln_Stop As Boolean                  '停止输出查询结果
Private Sub Form_Resize()                '根据窗体大小来调整网格,标题栏大小
    On Error Resume Next
    With CxbbGrid
        .Width = Me.Width - 160
        .Height = Me.Height - .Top - 400
    End With
    With Pic_Title
        .Width = Me.Width - 160
    End With
    GsToolbar.Left = Me.Width - GsToolbar.Width - 140
End Sub

Private Sub Form_Load()                  '窗体装入
    '调入打印页面设置窗体
    XtReportCode = "Cwzz_kmyeb"
    Load Dyymctbl
    ReportTitle = "科目余额及发生额表"
    
    '调整标题栏及网格、格式工具条位置
    Pic_Title.Left = 40
    Pic_Title.Top = SzToolbar.Top + SzToolbar.Height - 10
    CxbbGrid.Left = Pic_Title.Left
    CxbbGrid.Top = Pic_Title.Top + Pic_Title.Height + 20
    
    '调 入 网 格
    GridCode = "Cwzz_kmyeb"
    Call BzWgcsh(CxbbGrid, GridCode, GridInf(), GridBoolean(), GridInt(), GridStr())
    
    Qslz = GridInf(1)
    Sjhgd = GridInf(2)
    Sfxshjwg = GridInf(7)
    Szzls = CxbbGrid.Cols - 1
    
    '帐页格式
    Call FillCombo(Combo_AccFormat, "Cwzz_zygs", "", 0)
    Bln_End = True
    
    '调整标题位置
    SetTitlePos tsLabel(4)
    
    
End Sub

Private Sub Form_Unload(Cancel As Integer)                                  '窗体卸载
    '-----------------------
    Set clsAccAss = Nothing
    '------------------------
    '卸载条件窗体
    ZB_Frmkmyebtj.UnloadCheck.Value = 1
    Unload ZB_Frmkmyebtj
    '卸载打印页面设置窗体
    Unload Dyymctbl
End Sub

Private Sub GsToolbar_ButtonClick(ByVal Button As MSComctlLib.Button)       '网格格式调整
    Select Case Button.Key
    Case "bcgs"                                          '保存表格格式
        Call Bcwggs(CxbbGrid, GridCode, GridStr)
    Case "hfmrgs"                                        '恢复默认格式
        Call Hfmrgs(CxbbGrid, GridCode, GridStr)
    Case "szxsxm"                                        '设置显示项目
        Call Szxsxm(CxbbGrid, GridCode)
    End Select
End Sub

Private Sub SzToolbar_ButtonClick(ByVal Button As MSComctlLib.Button)
    Select Case Button.Key
    Case "ymsz"                                          '页面设置
        Dyymctbl.Show 1
    Case "yl"                                            '预 览
        Call bbyl(True)
    Case "dy"                                            '打 印
        Call bbyl(False)
    Case "cx"                                            '查 询
        ZB_Frmkmyebtj.Show 1
    Case "lj"                                            '累 计
        Call Combo_AccFormat_Click
    Case "zz"                                            '总 帐
        Call Sub_LcZflz
    Case "mxz"                                           '明细帐
        Call Sub_Lcmxz
    Case "sx"                                            '刷 新
        Call Timer1_Timer
    Case "bz"                                            '帮 助
        Call F1bz
    Case "fh"                                            '退 出
        Unload Me
    End Select
End Sub

Private Sub Timer1_Timer()                                 '在窗体激活后调入查询程序
    Timer1.Enabled = False
    
    Xt_Wait.Show
    Xt_Wait.Refresh
    
    '加快显示速度
    CxbbGrid.Redraw = False
    
    '生成查询结果
    Call Sub_Query
    Call Combo_AccFormat_Click
    CxbbGrid.Redraw = True
    Xt_Wait.Hide
End Sub

Private Sub Sub_Query()                                    '生成查询结果
    Dim RecTemp As New ADODB.Recordset          '临时使用动态集
    Dim Rec_AccSum As New ADODB.Recordset       '科目总帐动态集
    Dim Str_QueryCondi As String                '用户录入查询条件
    Dim Bln_IncluNotBook As Boolean             '是否包含未记帐凭证
    Dim Sqlstr As String                        '查询字符串
    Dim Coljsq As Long                          '网格列计数器
    Dim Jsqte As Long                           '临时动态计数器
    Dim Bln_RemoveEmpty As Boolean              '是否删除空数据行
    Dim Bln_Empty As Boolean                    '此数据行是否为空数据行
    Dim Int_BPeriod As Integer                  '查询起始会计期间
    Dim Int_EPeriod As Integer                  '查询终止会计期间
    Dim Int_Year As Integer                     '查询会计年度
    Dim Str_Ccode As String                     '查询会计科目
    Dim Str_CclassIndex As String               '科目类别索引号
    Dim Lng_ParCol As Long                      '类别科目所在列
    Dim Dbl_Qcyete#, Dbl_Qcslte#, Dbl_Qcwbte#   '期初金额,数量,外币
    Dim Dbl_Jejfhj#, Dbl_Jedfhj#, Dbl_Sljfhj#, Dbl_Sldfhj#, Dbl_Wbjfhj#, Dbl_Wbdfhj# '本期合计(金额,数量,外币)
    Dim Dbl_Jejflj#, Dbl_Jedflj#, Dbl_Sljflj#, Dbl_Sldflj#, Dbl_Wbjflj#, Dbl_Wbdflj# '截止累计(金额,数量,外币)
    Dim Dbl_Qmyete#, Dbl_Qmslte#, Dbl_Qmwbte#   '期末金额,数量,外币
    
    '以下为用户自定义部分[
    With ZB_Frmkmyebtj
        '显示查询会计期间
        Lab_TitleText(0).Caption = .Combo_Kjqj(0).Text & "-" & .Combo_Kjqj(1)
        Int_Year = Int(Mid(.Combo_Kjqj(0).Text, 1, 4))
        Int_BPeriod = Int(Mid(.Combo_Kjqj(0).Text, 6, 2))
        Int_EPeriod = Int(Mid(.Combo_Kjqj(1).Text, 6, 2))
        
        '是否包含未记帐凭证
        If .Chk_NotBook.Value = 1 Then
            Bln_IncluNotBook = True
        Else
            Bln_IncluNotBook = False
        End If
        
        '是否删除空数据行
        If .Chk_NotOuputZero = 1 Then
            Bln_RemoveEmpty = True
        Else
            Bln_RemoveEmpty = False
        End If
        Str_QueryCondi = " where 1=1 "
        For Jsqte = 1 To 4
            Select Case Jsqte
            Case 1   '科目类型
                If Trim(.Combo_Class.Text) <> "" Then
                    Str_QueryCondi = Str_QueryCondi & " and CClass='" & Trim(.Combo_Class.Text) & "'"
                End If
            Case 2   '科目号范围(起始科目号)
                Str_QueryCondi = Str_QueryCondi & " and CCode>='" & Trim(.LrText(0).Text) & "'"
            Case 3   '科目号范围(终止科目号)
                If Trim(.LrText(1).Text) <> "" Then
                    Str_QueryCondi = Str_QueryCondi & " and CCode<='" & Trim(.LrText(1).Text) & "'"
                End If
            Case 4   '科目级次范围(起始科目级次-终止科目级次)
                Str_QueryCondi = Str_QueryCondi & " and Cgrade>=" & Val(.LrText(2).Text) & " and Cgrade<=" & Val(.LrText(3).Text)
                '只有一级科目查询按科目类别合计才有道理
                If Val(.LrText(2).Text) = 1 And .Chk_ClassSum.Value = 1 Then
                    Bln_ClassSum = True
                Else
                    Bln_ClassSum = False
                End If
            End Select
        Next Jsqte
    End With
    
    '=====================bsj ===================================================
    '由于以上SQL语句在“包含末记帐凭证”查询时迅速太慢，所以在这里生成新的优化查询
    '考虑到此查询算法可能进一步优化，所以保留了调用组件的方法。（即调用DLL，返回记录集）
    '此方法只用于补救在数据量增多时，系统查询迅速变慢。
    '
    '此行为原程序   Set Rec_Query = Cw_DataEnvi.DataConnect.Execute(SqlStr)
    If WhichWay = True Then
        Dim myDll As Object
        Set myDll = CreateObject("Hxxd.GetRs")
        Set Rec_Query = myDll.Recordset
        Set myDll = Nothing
    Else
        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
        '在窗体卸载时会销毁临时记录集
    End If
    '================================bsj end=============================================
    With Rec_Query
        If Not (.EOF And .BOF) Then
            .MoveFirst
        End If
        CxbbGrid.Rows = CxbbGrid.FixedRows
        CxbbGrid.Rows = CxbbGrid.FixedRows + .RecordCount
        Jsqte = CxbbGrid.FixedRows
        Do While Not .EOF
            If Jsqte >= CxbbGrid.Rows Then