VB开发的ERP系统

    
    '调整标题位置
    SetTitlePos tsLabel(4)
    
End Sub

Private Sub Form_Unload(Cancel As Integer)                                  '窗体卸载
    Set clsAccAss = Nothing  '请除变量
    '卸载条件窗体
    ZF_Bm_FrmBmyebtj.UnloadCheck.Value = 1
    Unload ZF_Bm_FrmBmyebtj
    '卸载打印页面设置窗体
    Unload Dyymctbl
    Set clsAccAss = Nothing
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"                                            '查 询
        ZF_Bm_FrmBmyebtj.Show 1
    Case "lj"                                            '累 计
        Call Combo_AccFormat_Click
    Case "bz"                                            '帮 助
        Call F1bz
    Case "fh"                                            '退 出
        Unload Me
    End Select
End Sub

Private Sub Timer1_Timer()                                 '在窗体激活后调入查询程序
    Dim RecTemp As New ADODB.Recordset          '临时使用动态集
    Timer1.Enabled = False
    
    '加快显示速度
    CxbbGrid.Redraw = False
    
    Xt_Wait.Show
    Xt_Wait.Refresh
    
    '生成查询结果
    Call Sub_Query
    
    Call Combo_AccFormat_Click
    
    CxbbGrid.SetFocus
    
    CxbbGrid.Redraw = True
    
    Xt_Wait.Hide
    
End Sub

Private Sub Sub_Query()                                    '生成查询结果
    Dim Rec_Query As New ADODB.Recordset        '查询结果动态集
    Dim RecTemp As New ADODB.Recordset          '临时使用动态集
    Dim Rec_AccSum As New ADODB.Recordset       '科目总帐动态集
    Dim Str_QueryCondi As String                '用户录入查询条件
    Dim Sqlstr As String                        '查询字符串
    Dim Coljsq As Long                          '网格列计数器
    Dim Jsqte As Long                           '临时动态计数器
    Dim Bln_IncluNotBook As Boolean             '是否包含未记帐凭证
    Dim Bln_EndFlag As Boolean                  '判断当前科目是否为末级科目
    Dim Bln_ForeignFlag As Boolean              '判断此科目是否外币核算
    Dim Int_Tjfx As Integer                     '余额统计方向
    Dim Dbl_BeginYe As Double                   '查询起始余额
    Dim Dbl_EndYe As Double                     '查询终止余额
    Dim Bln_Fhxstj As Boolean                   '记录是否符合显示条件
    Dim Int_BPeriod As Integer                  '查询起始会计期间
    Dim Int_EPeriod As Integer                  '查询终止会计期间
    Dim Int_Year As Integer                     '查询会计年度
    Dim Str_Ccode As String                     '查询会计科目
    Dim Str_FzCode As String                    '查询辅助编码
    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#   '期末金额,数量,外币
    Dim Dbl_Sjzj(1 To 18) As Double             '数据总计
    Dim Bln_NotShowEmpty As Boolean             '数据全部为零不显示
    
    '以下为用户自定义部分[
    
    With ZF_Bm_FrmBmyebtj
        
        '查询部门编码
        Str_FzCode = Trim(.LrText(0).Tag)
        Lab_FzName.Caption = Trim(.LrText(0).Text)
        
        '显示查询会计期间
        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
        
        '数据为零不显示
        Bln_NotShowEmpty = True
        
    End With
    
    '计算所有用户选中(部门)的科目发生额及余额
    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()销毁对象
    '===============================================
    With Rec_Query
        
        CxbbGrid.Rows = CxbbGrid.FixedRows
        Jsqte = CxbbGrid.FixedRows - 1
        
        Do While Not .EOF
            
            Dbl_Qcyete = IIf(IsNull(Rec_Query.Fields("QcyeHj")), 0, Rec_Query.Fields("QcyeHj"))
            Dbl_Qcslte = IIf(IsNull(Rec_Query.Fields("QcslHj")), 0, Rec_Query.Fields("QcslHj"))
            Dbl_Qcwbte = IIf(IsNull(Rec_Query.Fields("QcwbHj")), 0, Rec_Query.Fields("QcwbHj"))
            Dbl_Jejfhj = IIf(IsNull(Rec_Query.Fields("Mjjehj")), 0, Rec_Query.Fields("Mjjehj"))
            Dbl_Jedfhj = IIf(IsNull(Rec_Query.Fields("Mdjehj")), 0, Rec_Query.Fields("Mdjehj"))
            Dbl_Sljfhj = IIf(IsNull(Rec_Query.Fields("Mjslhj")), 0, Rec_Query.Fields("Mjslhj"))
            Dbl_Sldfhj = IIf(IsNull(Rec_Query.Fields("Mdslhj")), 0, Rec_Query.Fields("Mdslhj"))
            Dbl_Wbjfhj = IIf(IsNull(Rec_Query.Fields("Mjwbhj")), 0, Rec_Query.Fields("Mjwbhj"))
            Dbl_Wbdfhj = IIf(IsNull(Rec_Query.Fields("Mdwbhj")), 0, Rec_Query.Fields("Mdwbhj"))
            Dbl_Jejflj = IIf(IsNull(Rec_Query.Fields("Byjfljjehj")), 0, Rec_Query.Fields("Byjfljjehj"))
            Dbl_Jedflj = IIf(IsNull(Rec_Query.Fields("Bydfljjehj")), 0, Rec_Query.Fields("Bydfljjehj"))
            Dbl_Sljflj = IIf(IsNull(Rec_Query.Fields("Byjfljslhj")), 0, Rec_Query.Fields("Byjfljslhj"))
            Dbl_Sldflj = IIf(IsNull(Rec_Query.Fields("Bydfljslhj")), 0, Rec_Query.Fields("Bydfljslhj"))
            Dbl_Wbjflj = IIf(IsNull(Rec_Query.Fields("Byjfljwbhj")), 0, Rec_Query.Fields("Byjfljwbhj"))
            Dbl_Wbdflj = IIf(IsNull(Rec_Query.Fields("Bydfljwbhj")), 0, Rec_Query.Fields("Bydfljwbhj"))
            Dbl_Qmyete = Dbl_Qcyete + Dbl_Jejfhj - Dbl_Jedfhj
            Dbl_Qmslte = Dbl_Qcslte + Dbl_Sljfhj - Dbl_Sldfhj
            Dbl_Qmwbte = Dbl_Qcwbte + Dbl_Wbjfhj - Dbl_Wbdfhj
            
            '判断是否输出数据
            
            Bln_Fhxstj = False
            
            If Bln_NotShowEmpty Then
                If Dbl_Qcyete <> 0 Or Dbl_Qcslte <> 0 Or Dbl_Qcwbte <> 0 Then
                    Bln_Fhxstj = True
                End If
                If Dbl_Jejfhj <> 0 Or Dbl_Jedfhj <> 0 Or Dbl_Sljfhj <> 0 Or Dbl_Sldfhj <> 0 Or Dbl_Wbjfhj <> 0 Or Dbl_Wbdfhj <> 0 Then
                    Bln_Fhxstj = True
                End If
                If Dbl_Jejflj <> 0 Or Dbl_Jedflj <> 0 Or Dbl_Sljflj <> 0 Or Dbl_Sldflj <> 0 Or Dbl_Wbjflj <> 0 Or Dbl_Wbdflj <> 0 Then
                    Bln_Fhxstj = True
                End If
            Else
                Bln_Fhxstj = True
            End If
            
            
            '数据输出
            If Bln_Fhxstj Then
                CxbbGrid.AddItem ""
                Jsqte = Jsqte + 1
                
                '数据总计
                If .Fields("EndFlag") Then
                    Dbl_Sjzj(1) = Dbl_Sjzj(1) + Dbl_Qcyete
                    Dbl_Sjzj(2) = Dbl_Sjzj(2) + Dbl_Qcslte
                    Dbl_Sjzj(3) = Dbl_Sjzj(3) + Dbl_Qcwbte
                    Dbl_Sjzj(4) = Dbl_Sjzj(4) + Dbl_Jejfhj
                    Dbl_Sjzj(5) = Dbl_Sjzj(5) + Dbl_Jedfhj
                    Dbl_Sjzj(6) = Dbl_Sjzj(6) + Dbl_Sljfhj
                    Dbl_Sjzj(7) = Dbl_Sjzj(7) + Dbl_Sldfhj
                    Dbl_Sjzj(8) = Dbl_Sjzj(8) + Dbl_Wbjfhj
                    Dbl_Sjzj(9) = Dbl_Sjzj(9) + Dbl_Wbdfhj
                    Dbl_Sjzj(10) = Dbl_Sjzj(10) + Dbl_Jejflj
                    Dbl_Sjzj(11) = Dbl_Sjzj(11) + Dbl_Jedflj
                    Dbl_Sjzj(12) = Dbl_Sjzj(12) + Dbl_Sljflj
                    Dbl_Sjzj(13) = Dbl_Sjzj(13) + Dbl_Sldflj
                    Dbl_Sjzj(14) = Dbl_Sjzj(14) + Dbl_Wbjflj
                    Dbl_Sjzj(15) = Dbl_Sjzj(15) + Dbl_Wbdflj
                    Dbl_Sjzj(16) = Dbl_Sjzj(16) + Dbl_Qmyete
                    Dbl_Sjzj(17) = Dbl_Sjzj(17) + Dbl_Qmslte
                    Dbl_Sjzj(18) = Dbl_Sjzj(18) + Dbl_Qmwbte
                End If
                
                CxbbGrid.RowHeight(Jsqte) = Sjhgd
                
                CxbbGrid.TextMatrix(Jsqte, Sydz("001", GridStr(), Szzls)) = Trim(.Fields("CCode"))            '科目编码
                CxbbGrid.TextMatrix(Jsqte, Sydz("002", GridStr(), Szzls)) = Trim(.Fields("CName") & "")       '科目名称
                
                
                '将期初数据写入网格
                If Dbl_Qcyete = 0 Then
                    CxbbGrid.TextMatrix(Jsqte, Sydz("003", GridStr(), Szzls)) = "平"     '期初方向
                    If Bln_EndFlag And Dbl_Qcslte <> 0 Then
                        CxbbGrid.TextMatrix(Jsqte, Sydz("006", GridStr(), Szzls)) = Dbl_Qcslte
                    End If
                    If Bln_EndFlag And Bln_ForeignFlag And Dbl_Qcwbte <> 0 Then
                        CxbbGrid.TextMatrix(Jsqte, Sydz("007", GridStr(), Szzls)) = Dbl_Qcwbte
                    End If
                Else
                    
                    If Dbl_Qcyete > 0 Then
                        CxbbGrid.TextMatrix(Jsqte, Sydz("003", GridStr(), Szzls)) = "借"
                        CxbbGrid.TextMatrix(Jsqte, Sydz("004", GridStr(), Szzls)) = Dbl_Qcyete
                        CxbbGrid.TextMatrix(Jsqte, Sydz("008", GridStr(), Szzls)) = Dbl_Qcyete
                        If Bln_EndFlag And Dbl_Qcslte <> 0 Then
                            CxbbGrid.TextMatrix(Jsqte, Sydz("006", GridStr(), Szzls)) = Dbl_Qcslte
                        End If
                        If Bln_EndFlag And Bln_ForeignFlag And Dbl_Qcwbte <> 0 Then
                            CxbbGrid.TextMatrix(Jsqte, Sydz("007", GridStr(), Szzls)) = Dbl_Qcwbte
                        End If
                    Else
                        CxbbGrid.TextMatrix(Jsqte, Sydz("003", GridStr(), Szzls)) = "贷"
                        CxbbGrid.TextMatrix(Jsqte, Sydz("005", GridStr(), Szzls)) = -Dbl_Qcyete
                        CxbbGrid.TextMatrix(Jsqte, Sydz("008", GridStr(), Szzls)) = -Dbl_Qcyete
                        If Bln_EndFlag And Dbl_Qcslte <> 0 Then
                            CxbbGrid.TextMatrix(Jsqte, Sydz("006", GridStr(), Szzls)) = -Dbl_Qcslte
                        End If
                        If Bln_EndFlag And Bln_ForeignFlag And Dbl_Qcwbte <> 0 Then
                            CxbbGrid.TextMatrix(Jsqte, Sydz("007", GridStr(), Szzls)) = -Dbl_Qcwbte
                        End If
                    End If
                End If
                
                '将期间合计数据写入网格
                If Dbl_Jejfhj <> 0 Then
                    CxbbGrid.TextMatrix(Jsqte, Sydz("009", GridStr(), Szzls)) = Dbl_Jejfhj       '本期发生.借方
                    CxbbGrid.TextMatrix(Jsqte, Sydz("013", GridStr(), Szzls)) = Dbl_Jejfhj       '本期借方发生.金额
                End If
                If Dbl_Jedfhj <> 0 Then
                    CxbbGrid.TextMatrix(Jsqte, Sydz("010", GridStr(), Szzls)) = Dbl_Jedfhj       '本期发生.贷方
                    CxbbGrid.TextMatrix(Jsqte, Sydz("016", GridStr(), Szzls)) = Dbl_Jedfhj       '本期贷方发生.金额
                End If
                
                '仅有末级科目才显示数量，外币
                
                If Bln_EndFlag Then
                    If Dbl_Sljfhj <> 0 Then
                        CxbbGrid.TextMatrix(Jsqte, Sydz("011", GridStr(), Szzls)) = Dbl_Sljfhj   '本期借方发生.数量
                    End If
                    If Dbl_Sldfhj <> 0 Then
                        CxbbGrid.TextMatrix(Jsqte, Sydz("014", GridStr(), Szzls)) = Dbl_Sldfhj   '本期贷方发生.数量