VB开发的ERP系统

    '========bsj================
    '设置窗体图标与主界面图标一致
    Me.Icon = XT_Main.Icon
    '==========================
    '调入打印页面设置窗体
    XtReportCode = "Cwzz_gr_slzz"
    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_gr_slzz"
    Call BzWgcsh(CxbbGrid, GridCode, GridInf(), GridBoolean(), GridInt(), GridStr())
    
    Qslz = GridInf(1)
    Sjhgd = GridInf(2)
    Sfxshjwg = GridInf(7)
    Szzls = CxbbGrid.Cols - 1
    
    '填充查询年度
    CxbbGrid.TextMatrix(0, Sydz("001", GridStr(), Szzls)) = Trim(Str(Xtyear)) + "年"
    CxbbGrid.TextMatrix(0, Sydz("002", GridStr(), Szzls)) = Trim(Str(Xtyear)) + "年"
    
    '帐页格式
    Call FillCombo(Combo_AccFormat, "Cwzz_zygs", "", 0)
    
    '调整标题位置
    SetTitlePos tsLabel(4)
    
End Sub

Private Sub Form_Unload(Cancel As Integer)                                  '窗体卸载
    '卸载条件窗体
    ZF_Gr_Frmslzztj.UnloadCheck.Value = 1
    Unload ZF_Gr_Frmslzztj
    '卸载打印页面设置窗体
    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"                                            '查 询
        ZF_Gr_Frmslzztj.Show 1
    Case "bz"                                            '帮 助
        Call F1bz
    Case "fh"                                            '退 出
        Unload Me
    End Select
End Sub

Private Sub Timer1_Timer()                                 '在窗体激活后调入查询程序
    Dim RecTemp As New ADODB.Recordset          '临时使用动态集
    Dim Str_QueryCondi As String                '用户录入查询条件
    
    Timer1.Enabled = False
    
    With ZF_Gr_Frmslzztj
        '辅助查询科目
        Call FillImageCombo(Imgebo_FzCcode, "Cwzz_grwlkm", 0)
        
        For Jsqte = 1 To Imgebo_FzCcode.ComboItems.count
            If Imgebo_FzCcode.ComboItems.Item(Jsqte).Text = ZF_Gr_Frmslzztj.Imgebo_FzCcode.Text Then
                Imgebo_FzCcode.ComboItems.Item(Jsqte).Selected = True
                Imgebo_FzCcode.Refresh
                Exit For
            End If
        Next Jsqte
        
        '查询个人
        Call FillImageCombo(Imgebo_FzCode, "Cwzz_person", 0)
        For Jsqte = 1 To Imgebo_FzCode.ComboItems.count
            If Imgebo_FzCode.ComboItems.Item(Jsqte).Key = "@" + Trim(ZF_Gr_Frmslzztj.LrText(0).Tag) Then
                Imgebo_FzCode.ComboItems.Item(Jsqte).Selected = True
                Imgebo_FzCode.Refresh
                Exit For
            End If
        Next Jsqte
    End With
    
    '生成查询结果
    Call Sub_ScQuery
    
End Sub

Private Sub Imgebo_FzCcode_Click()                        '点击科目列表
    Call Sub_ScQuery
End Sub

Private Sub Imgebo_FzCode_Click()                         '点击辅助个人列表
    Call Sub_ScQuery
End Sub

Private Sub Sub_ScQuery()                                 '生成查询结果
    Xt_Wait.Show
    Xt_Wait.Refresh
    CxbbGrid.Redraw = True
    
    '加快显示速度
    CxbbGrid.Redraw = False
    
    '生成查询结果
    Call Sub_Query
    
    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_Ccode As String                     '查询科目
    Dim Str_FzCode As String                    '查询辅助个人编码
    Dim Sqlstr As String                        '查询字符串
    Dim Coljsq As Long                          '网格列计数器
    Dim Jsqte As Long                           '临时动态计数器
    Dim Int_Year As Integer                     '查询会计年度
    Dim Bln_IncluNotBook As Boolean             '是否包含未记帐凭证
    Dim Bln_EndFlag As Boolean                  '判断当前科目是否为末级科目
    Dim Bln_ForeignFlag As Boolean              '判断此科目是否外币核算
    Dim Int_DqPeriod As Integer                 '查询进行当前会计期间
    
    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#   '期末金额,数量,外币
    '以下为用户自定义部分[
    
    '清除原查询数据
    CxbbGrid.Rows = CxbbGrid.FixedRows
    
    '得到当前查询科目,并判断是否为末级科目
    Str_Ccode = GetComboKey(Imgebo_FzCcode, 0)
    Sqlstr = "SELECT EndFlag,AccFormat,ForeignFlag,ForeignCurrName,ConVertFlag From Cwzz_AccCode Left JOIN Gy_ForeignCurrency ON" & _
    " Cwzz_AccCode.ForeignCurrCode = Gy_ForeignCurrency.ForeignCurrCode Where Ccode='" & Str_Ccode & "'"
    Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
    If Not RecTemp.EOF Then
        Bln_EndFlag = RecTemp.Fields("EndFlag")
        Combo_AccFormat.Text = Trim(RecTemp.Fields("AccFormat") & "")
        If RecTemp.Fields("ForeignFlag") Then
            Lab_TitleMess(2).Visible = True
            Lab_TitleText(1).Caption = Trim(RecTemp.Fields("ForeignCurrName") & "")
            Bln_ForeignFlag = True
            Bln_ConVertFlag = IIf(IsNull(RecTemp.Fields("ConVertFlag")), False, RecTemp.Fields("ConVertFlag"))
        Else
            Lab_TitleMess(2).Visible = False
            Bln_ForeignFlag = False
            Lab_TitleText(1).Caption = ""
        End If
    End If
    
    '得到查询辅助个人编码
    Str_FzCode = GetComboKey(Imgebo_FzCode, 0)
    
    '得到查询年度,并判断是否包含未记帐凭证
    With ZF_Gr_Frmslzztj
        
        Int_Year = Xtyear
        
        '是否包含未记帐凭证
        If .Chk_NotBook.Value = 1 Then
            Bln_IncluNotBook = True
        Else
            Bln_IncluNotBook = False
        End If
        
    End With
    
    '初始化各种值
    Dbl_Qcyete = 0
    Dbl_Qcslte = 0
    Dbl_Qcwbte = 0
    
    Dbl_Jejfhj = 0
    Dbl_Jedfhj = 0
    Dbl_Sljfhj = 0
    Dbl_Sldfhj = 0
    Dbl_Wbjfhj = 0
    Dbl_Wbdfhj = 0
    
    Dbl_Jejflj = 0
    Dbl_Jedflj = 0
    Dbl_Sljflj = 0
    Dbl_Sldflj = 0
    Dbl_Wbjflj = 0
    Dbl_Wbdflj = 0
    
    Jsqte = CxbbGrid.FixedRows - 1
    
    '1.读出上年结转余额(数量,外币,金)
    Sqlstr = "SELECT Qcyehj=Isnull(Sum(Qcye),0),Qcslhj=Isnull(Sum(Qcsl),0),Qcwbhj=Isnull(Sum(Qcwb),0) From Cwzz_AccSumAssi Where Ccode LIKE '" & Str_Ccode & "%' And PersonCode='" & Str_FzCode & "'And Year=" & Int_Year & " And Period=1"
    Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
    If Not RecTemp.EOF Then
        Dbl_Qcyete = RecTemp.Fields("Qcyehj")
        Dbl_Qcslte = RecTemp.Fields("Qcslhj")
        Dbl_Qcwbte = RecTemp.Fields("Qcwbhj")
    End If
    
    CxbbGrid.AddItem ""
    Jsqte = Jsqte + 1
    
    CxbbGrid.TextMatrix(Jsqte, Sydz("004", GridStr(), Szzls)) = "上年结转"
    
    '输出余额
    Call Sub_OutBalance(Jsqte, Bln_EndFlag, Bln_ForeignFlag, Dbl_Qcyete, Dbl_Qcslte, Dbl_Qcwbte)
    
    
    '2.读出所有会计期间记账数据
    Sqlstr = "SELECT Period,Mjjehj=Isnull(SUM(Mjje),0), Mdjehj=Isnull(SUM(Mdje),0), Mjslhj=Isnull(SUM(Mjsl),0), Mdslhj=Isnull(SUM(Mdsl),0)," & _
    " Mjwbhj=Isnull(SUM(Mjwb),0), Mdwbhj=Isnull(SUM(Mdwb),0) From Cwzz_AccSumAssi Where Ccode like '" & Str_Ccode & "%'  And PersonCode='" & Str_FzCode & "' And Year=" & Int_Year & _
    " GROUP BY Period"
    Set Rec_AccSum = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
    
    '3.如果包含未记帐凭证查询,则读出本年度所有未记帐凭证各会计期间合计数据
    If Bln_IncluNotBook Then
        Sqlstr = "SELECT Period,Jfjehj=Isnull(SUM(Jfje),0),Dfjehj=Isnull(SUM(Dfje),0),Jfslhj=Isnull(SUM(Jfsl),0),Dfslhj=Isnull(SUM(Dfsl),0)," & _
        " Wbjfjehj=Isnull(SUM(Wbjfje),0),Wbdfjehj=Isnull(SUM(Wbdfje),0) From Cwzz_V_AccVouch WHERE BookFlag=0 And Ccode like '" & Str_Ccode & "%'  And PersonCode='" & Str_FzCode & "' And Year=" & Int_Year & _
        " GROUP BY Period"
        Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
    End If
    
    '4.将各会计期间科目合计数据写入网格,同时计算本年累计,余额将其写入网格
    For Int_DqPeriod = 1 To 12
        
        '本期合计数据清零
        Dbl_Jejfhj = 0
        Dbl_Jedfhj = 0
        Dbl_Sljfhj = 0
        Dbl_Sldfhj = 0
        Dbl_Wbjfhj = 0
        Dbl_Wbdfhj = 0
        
        With Rec_AccSum
            If .RecordCount <> 0 Then
                .MoveFirst
                .Find "Period =" & Int_DqPeriod
                If Not .EOF Then