+

VB开发的ERP系统

    '调入打印页面设置窗体
    
    XtReportCode = "Cwzz_qcyelrdz"
    Load Dyymctbl
    ReportTitle = "帐目对帐结果"
    
    '调 入 网 格
    GridCode = "Cwzz_qcyelrdz"
    Call BzWgcsh(CxbbGrid, GridCode, GridInf(), GridBoolean(), GridInt(), GridStr())
    
    Qslz = GridInf(1)
    Sjhgd = GridInf(2)
    Sfxshjwg = GridInf(7)
    Szzls = CxbbGrid.Cols - 1
    
    '调整标题位置
    SetTitlePos tsLabel(4)
    
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 Tlb_Action_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 "dz"                                            '对 帐
        Call Sub_AccCheck
    Case "bz"                                            '帮 助
        Call F1bz
    Case "fh"                                            '退 出
        Unload Me
    End Select
End Sub

Private Sub Sub_AccCheck()                                                                  '帐目核对
    Dim Int_CheckSele As Integer
    
    '初始化对帐结果显示
    CxbbGrid.Rows = CxbbGrid.FixedRows
    CxbbGrid.Refresh
    For Jsqte = 0 To 5
        Lab_CheckJg(Jsqte).Visible = False
        Lab_Check1(Jsqte).ForeColor = &H80000012
    Next Jsqte
    If Fun_Hdsxjkm Then
        Lab_CheckJg(0).Visible = True
    End If
    For Int_CheckSele = 1 To 5
        If Fun_HdZzFzz(Int_CheckSele) Then
            Lab_CheckJg(Int_CheckSele).Visible = True
        End If
    Next Int_CheckSele
    
    Lab_Ccode = ""
End Sub

Private Function Fun_HdZzFzz(Int_CheckSele As Integer) As Boolean                                                    '核对总帐与辅助帐(客户)是否平衡
    
    '1-部门 2-客户 3-供应商 4-个人 5-项目
    
    Dim RecTemp As New ADODB.Recordset                   '临时使用动态集
    Dim Rec_AccSum As New ADODB.Recordset                '科目总帐动态集
    Dim Sqlstr As String                                 '临时查询字符串
    Dim Int_NotCheck As Integer                          '未能核对通过科目个数
    
    Lab_Check1(Int_CheckSele).ForeColor = &HFF&
    Int_NotCheck = 0
    
    Select Case Int_CheckSele
    Case 1
        Sqlstr = "SELECT Cwzz_AccCode.Ccode, Ycye=ISNULL(Ycye,0), Qcye=IsNULL(Qcye,0), Mjje=ISNULL(Mjje,0), Mdje=ISNULL(Mdje,0), Byjfljje=ISNULL(Byjfljje,0), Bydfljje=ISNULL(Bydfljje,0), Qmye=ISNULL(Qmye,0)" & _
        " FROM  Cwzz_AccCode LEFT OUTER JOIN Cwzz_AccSum ON" & _
        " Cwzz_AccCode.Ccode = Cwzz_AccSum.Ccode And Cwzz_AccSum.Year = " & Int_CheckYear & " And Period =" & Int_CheckPeriod & _
        " Where Cwzz_AccCode.DeptFlag=1 And Cwzz_AccCode.EndFlag=1"
    Case 2
        Sqlstr = "SELECT Cwzz_AccCode.Ccode, Ycye=ISNULL(Ycye,0), Qcye=IsNULL(Qcye,0), Mjje=ISNULL(Mjje,0), Mdje=ISNULL(Mdje,0), Byjfljje=ISNULL(Byjfljje,0), Bydfljje=ISNULL(Bydfljje,0), Qmye=ISNULL(Qmye,0)" & _
        " FROM  Cwzz_AccCode LEFT OUTER JOIN Cwzz_AccSum ON" & _
        " Cwzz_AccCode.Ccode = Cwzz_AccSum.Ccode And Cwzz_AccSum.Year = " & Int_CheckYear & " And Period =" & Int_CheckPeriod & _
        " Where Cwzz_AccCode.CusFlag=1 And Cwzz_AccCode.EndFlag=1"
    Case 3
        Sqlstr = "SELECT Cwzz_AccCode.Ccode, Ycye=ISNULL(Ycye,0), Qcye=IsNULL(Qcye,0), Mjje=ISNULL(Mjje,0), Mdje=ISNULL(Mdje,0), Byjfljje=ISNULL(Byjfljje,0), Bydfljje=ISNULL(Bydfljje,0), Qmye=ISNULL(Qmye,0)" & _
        " FROM  Cwzz_AccCode LEFT OUTER JOIN Cwzz_AccSum ON" & _
        " Cwzz_AccCode.Ccode = Cwzz_AccSum.Ccode And Cwzz_AccSum.Year = " & Int_CheckYear & " And Period =" & Int_CheckPeriod & _
        " Where Cwzz_AccCode.SupplierFlag=1 And Cwzz_AccCode.EndFlag=1"
    Case 4
        Sqlstr = "SELECT Cwzz_AccCode.Ccode, Ycye=ISNULL(Ycye,0), Qcye=IsNULL(Qcye,0), Mjje=ISNULL(Mjje,0), Mdje=ISNULL(Mdje,0), Byjfljje=ISNULL(Byjfljje,0), Bydfljje=ISNULL(Bydfljje,0), Qmye=ISNULL(Qmye,0)" & _
        " FROM  Cwzz_AccCode LEFT OUTER JOIN Cwzz_AccSum ON" & _
        " Cwzz_AccCode.Ccode = Cwzz_AccSum.Ccode And Cwzz_AccSum.Year = " & Int_CheckYear & " And Period =" & Int_CheckPeriod & _
        " Where Cwzz_AccCode.PersonFlag=1 And Cwzz_AccCode.EndFlag=1"
    Case 5
        Sqlstr = "SELECT Cwzz_AccCode.Ccode,Cwzz_AccCode.ItemClassCode,Ycye=ISNULL(Ycye,0), Qcye=IsNULL(Qcye,0), Mjje=ISNULL(Mjje,0), Mdje=ISNULL(Mdje,0), Byjfljje=ISNULL(Byjfljje,0), Bydfljje=ISNULL(Bydfljje,0), Qmye=ISNULL(Qmye,0)" & _
        " FROM  Cwzz_AccCode LEFT OUTER JOIN Cwzz_AccSum ON" & _
        " Cwzz_AccCode.Ccode = Cwzz_AccSum.Ccode And Cwzz_AccSum.Year = " & Int_CheckYear & " And Period =" & Int_CheckPeriod & _
        " Where Cwzz_AccCode.ItemFlag=1 And Cwzz_AccCode.EndFlag=1"
    End Select
    Set Rec_AccSum = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
    With Rec_AccSum
        Do While Not .EOF
            Lab_Ccode.Caption = Trim(.Fields("Ccode"))
            Lab_Ccode.Refresh
            
            Sqlstr = "SELECT YcyeHj=IsNull(SUM(Ycye),0), QcyeHj=Isnull(SUM(Qcye),0),MjjeHj=Isnull(SUM(Mjje),0), MdjeHj=Isnull(SUM(Mdje),0)," & _
            " ByjfljjeHj=IsNull(SUM(Byjfljje),0), BydfljjeHj=IsNull(SUM(Bydfljje),0),Qmyehj=IsNull(SUM(Qmye),0)" & _
            " FROM Cwzz_AccSumAssi " & _
            " WHERE Cwzz_AccSumAssi.Ccode ='" & Trim(.Fields("Ccode")) & "' AND Year = " & Int_CheckYear & " AND Period =" & Int_CheckPeriod
            Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
            If Not RecTemp.EOF Then
                If .Fields("Ycye") <> RecTemp.Fields("YcyeHj") Or .Fields("Qcye") <> RecTemp.Fields("Qcyehj") Or .Fields("Mjje") <> RecTemp.Fields("MjjeHj") Or .Fields("Mdje") <> RecTemp.Fields("MdjeHj") Or .Fields("Byjfljje") <> RecTemp.Fields("Byjfljjehj") Or .Fields("Bydfljje") <> RecTemp.Fields("Bydfljjehj") Or .Fields("Qmye") <> RecTemp.Fields("Qmyehj") Then
                    Int_NotCheck = Int_NotCheck + 1
                    '填充记录错误列表
                    Call Sub_AddRec(Trim(.Fields("Ccode")), "总帐", .Fields("Ycye"), .Fields("Qcye"), .Fields("Mjje"), .Fields("Mdje"), .Fields("Byjfljje"), .Fields("Bydfljje"), .Fields("Qmye"))
                    Select Case Int_CheckSele
                    Case 1
                        Call Sub_AddRec(Trim(.Fields("Ccode")), "部门帐", RecTemp.Fields("Ycyehj"), RecTemp.Fields("Qcyehj"), RecTemp.Fields("Mjjehj"), RecTemp.Fields("Mdjehj"), RecTemp.Fields("Byjfljjehj"), RecTemp.Fields("Bydfljjehj"), RecTemp.Fields("Qmyehj"))
                    Case 2
                        Call Sub_AddRec(Trim(.Fields("Ccode")), "客户帐", RecTemp.Fields("Ycyehj"), RecTemp.Fields("Qcyehj"), RecTemp.Fields("Mjjehj"), RecTemp.Fields("Mdjehj"), RecTemp.Fields("Byjfljjehj"), RecTemp.Fields("Bydfljjehj"), RecTemp.Fields("Qmyehj"))
                    Case 3
                        Call Sub_AddRec(Trim(.Fields("Ccode")), "供应商帐", RecTemp.Fields("Ycyehj"), RecTemp.Fields("Qcyehj"), RecTemp.Fields("Mjjehj"), RecTemp.Fields("Mdjehj"), RecTemp.Fields("Byjfljjehj"), RecTemp.Fields("Bydfljjehj"), RecTemp.Fields("Qmyehj"))
                    Case 4
                        Call Sub_AddRec(Trim(.Fields("Ccode")), "个人帐", RecTemp.Fields("Ycyehj"), RecTemp.Fields("Qcyehj"), RecTemp.Fields("Mjjehj"), RecTemp.Fields("Mdjehj"), RecTemp.Fields("Byjfljjehj"), RecTemp.Fields("Bydfljjehj"), RecTemp.Fields("Qmyehj"))
                    Case 5
                        Call Sub_AddRec(Trim(.Fields("Ccode")), "项目帐", RecTemp.Fields("Ycyehj"), RecTemp.Fields("Qcyehj"), RecTemp.Fields("Mjjehj"), RecTemp.Fields("Mdjehj"), RecTemp.Fields("Byjfljjehj"), RecTemp.Fields("Bydfljjehj"), RecTemp.Fields("Qmyehj"))
                    End Select
                End If
            End If
            
            .MoveNext
        Loop
    End With
    If Int_NotCheck <> 0 Then
        Fun_HdZzFzz = False
    Else
        Fun_HdZzFzz = True
        Lab_Check1(Int_CheckSele).ForeColor = &H80000012
    End If
End Function

Private Function Fun_Hdsxjkm() As Boolean                                                   '核对总帐上下级科目是否平衡
    Dim RecTemp As New ADODB.Recordset                   '临时使用动态集
    Dim Rec_AccSum As New ADODB.Recordset                '科目总帐动态集
    Dim Sqlstr As String                                 '临时查询字符串
    Dim Int_NotCheck As Integer                          '未能核对通过科目个数
    
    Lab_Check1(Int_CheckSele).ForeColor = &HFF&
    Int_NotCheck = 0
    
    Sqlstr = "SELECT Cwzz_AccCode.Ccode, Ycye=ISNULL(Ycye,0), Qcye=IsNULL(Qcye,0), Mjje=ISNULL(Mjje,0), Mdje=ISNULL(Mdje,0), Byjfljje=ISNULL(Byjfljje,0), Bydfljje=ISNULL(Bydfljje,0), Qmye=ISNULL(Qmye,0)" & _
    " FROM  Cwzz_AccCode LEFT OUTER JOIN Cwzz_AccSum ON" & _
    " Cwzz_AccCode.Ccode = Cwzz_AccSum.Ccode And Cwzz_AccSum.Year = " & Int_CheckYear & " And Period =" & Int_CheckPeriod & _
    " Where Cwzz_AccCode.EndFlag=0"
    Set Rec_AccSum = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
    With Rec_AccSum
        Do While Not .EOF
            Lab_Ccode.Caption = Trim(.Fields("Ccode"))
            Lab_Ccode.Refresh
            
            Sqlstr = "SELECT SUM(Ycye) AS YcyeHj, SUM(Qcye) AS QcyeHj, SUM(Mjje) AS MjjeHj, SUM(Mdje) AS MdjeHj," & _
            " SUM(Byjfljje) AS ByjfljjeHj, SUM(Bydfljje) AS BydfljjeHj, SUM(Qmye) AS Qmyehj" & _
            " FROM Cwzz_AccSum LEFT OUTER JOIN Cwzz_AccCode ON Cwzz_AccSum.Ccode = Cwzz_AccCode.Ccode" & _
            " WHERE Cwzz_AccSum.Ccode LIKE '" & Trim(.Fields("Ccode")) & "%' AND Year = " & Int_CheckYear & " AND Period =" & Int_CheckPeriod & " AND Cwzz_AccCode.EndFlag = 1"
            Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
            If Not RecTemp.EOF Then
                If .Fields("Ycye") <> RecTemp.Fields("YcyeHj") Or .Fields("Qcye") <> RecTemp.Fields("Qcyehj") Or .Fields("Mjje") <> RecTemp.Fields("MjjeHj") Or .Fields("Mdje") <> RecTemp.Fields("MdjeHj") Or .Fields("Byjfljje") <> RecTemp.Fields("Byjfljjehj") Or .Fields("Bydfljje") <> RecTemp.Fields("Bydfljjehj") Or .Fields("Qmye") <> RecTemp.Fields("Qmyehj") Then
                    Int_NotCheck = Int_NotCheck + 1
                    
                    '填充记录错误列表
                    Call Sub_AddRec(Trim(.Fields("Ccode")), "总帐上级", .Fields("Ycye"), .Fields("Qcye"), .Fields("Mjje"), .Fields("Mdje"), .Fields("Byjfljje"), .Fields("Bydfljje"), .Fields("Qmye"))
                    Call Sub_AddRec(Trim(.Fields("Ccode")), "总帐下级", RecTemp.Fields("Ycyehj"), RecTemp.Fields("Qcyehj"), RecTemp.Fields("Mjjehj"), RecTemp.Fields("Mdjehj"), RecTemp.Fields("Byjfljjehj"), RecTemp.Fields("Bydfljjehj"), RecTemp.Fields("Qmyehj"))
                    
                End If
            Else
                If .Fields("Ycye") <> 0 Or .Fields("Qcye") <> 0 Or .Fields("Mjje") <> 0 Or .Fields("Mdje") <> 0 Or .Fields("Byjfljje") <> 0 Or .Fields("Bydfljje") <> 0 Or .Fields("Qmye") <> 0 Then
                    '填充记录错误列表
                    Call Sub_AddRec(Trim(.Fields("Ccode")), "总帐上级", .Fields("Ycye"), .Fields("Qcye"), .Fields("Mjje"), .Fields("Mdje"), .Fields("Byjfljje"), .Fields("Bydfljje"), .Fields("Qmye"))
                    Call Sub_AddRec(Trim(.Fields("Ccode")), "总帐下级", 0, 0, 0, 0, 0, 0, 0)
                End If
            End If
            .MoveNext
        Loop
    End With
    If Int_NotCheck <> 0 Then
        Fun_Hdsxjkm = False
    Else
        Fun_Hdsxjkm = True
        Lab_Check1(Int_CheckSele).ForeColor = &H80000012
    End If
End Function

Private Sub Sub_AddRec(Str_Ccode As String, CheckItem As String, Ycye#, Qcye#, Mjje#, Mdje#, Byjfljje#, Bydfljje#, Qmye#)            '填充对帐错误记录
    '函数参数说明:科目编码,核对项目,年初余额,期初余额,本期借方发生,本期贷方发生,本年累计借方发生,本年累计贷方发生,期末余额
    
    Dim RecTemp As New ADODB.Recordset                   '临时使用动态集
    Dim Sqlstr As String                                 '临时查询字符串
    Sqlstr = "SELECT Cwzz_AccCode.CName,BalanceOri From Cwzz_AccCode Where CCode='" & Str_Ccode & "'"
    Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
    With CxbbGrid
        .AddItem ""
        .RowHeight(.Rows - 1) = Sjhgd
        .TextMatrix(.Rows - 1, Sydz("001", GridStr(), Szzls)) = Str_Ccode                                   '科目编码
        If Not RecTemp.EOF Then
            .TextMatrix(.Rows - 1, Sydz("002", GridStr(), Szzls)) = Trim(RecTemp.Fields("Cname") & "")       '科目名称
        End If
        .TextMatrix(.Rows - 1, Sydz("003", GridStr(), Szzls)) = CheckItem                                   '核对项目
        If Not RecTemp.EOF Then
            .TextMatrix(.Rows - 1, Sydz("004", GridStr(), Szzls)) = Trim(RecTemp.Fields("BalanceOri"))       '余额方向
        End If
        If Ycye <> 0 Then                                                                                   '年初余额
            If .TextMatrix(.Rows - 1, Sydz("004", GridStr(), Szzls)) = "借" Then
                .TextMatrix(.Rows - 1, Sydz("005", GridStr(), Szzls)) = Ycye
            Else
                .TextMatrix(.Rows - 1, Sydz("005", GridStr(), Szzls)) = -Ycye
            End If
        End If
        If Qcye <> 0 Then                                                                                   '期初余额
            If .TextMatrix(.Rows - 1, Sydz("004", GridStr(), Szzls)) = "借" Then
                .TextMatrix(.Rows - 1, Sydz("006", GridStr(), Szzls)) = Qcye
            Else
                .TextMatrix(.Rows - 1, Sydz("006", GridStr(), Szzls)) = -Qcye
            End If
        End If
        If Mjje <> 0 Then                                                                                   '本期借方发生
            .TextMatrix(.Rows - 1, Sydz("007", GridStr(), Szzls)) = Mjje
        End If
        If Mdje <> 0 Then                                                                                   '本期贷方发生
            .TextMatrix(.Rows - 1, Sydz("008", GridStr(), Szzls)) = Mdje
        End If
        If Byjfljje <> 0 Then                                                                               '本年借方累计发生
            .TextMatrix(.Rows - 1, Sydz("009", GridStr(), Szzls)) = Byjfljje
        End If
        If Bydfljje <> 0 Then                                                                               '本年贷方累计发生
            .TextMatrix(.Rows - 1, Sydz("010", GridStr(), Szzls)) = Bydfljje
        End If
        If Qmye <> 0 Then                                                                                   '期末余额
            If .TextMatrix(.Rows - 1, Sydz("004", GridStr(), Szzls)) = "借" Then
                .TextMatrix(.Rows - 1, Sydz("011", GridStr(), Szzls)) = Qmye
            Else
                .TextMatrix(.Rows - 1, Sydz("011", GridStr(), Szzls)) = -Qmye
            End If
        End If
    End With
End Sub

Private Sub bbyl(bbylte As Boolean)                    '报表打印预览
    Dim Bbzbt$, Bbxbt() As String, bbxbtzzxs() As Integer, Bbxbtgs As Integer
    Dim Bbbwh() As String, Bbbwhzzxs() As Integer, Bbbwhgs As Integer
    Bbxbtgs = 1                                          '报 表 小 标 题 行 数
    Bbbwhgs = 0                                          '报 表 表 尾 行 数
    ReDim Bbxbt(1 To Bbxbtgs)
    ReDim bbxbtzzxs(1 To Bbxbtgs)
    If Bbbwhgs <> 0 Then
        ReDim Bbbwh(1 To Bbbwhgs)
        ReDim Bbbwhzzxs(1 To Bbbwhgs)
    End If
    Bbzbt = ReportTitle
    Bbxbt(1) = " "
    bbxbtzzxs(1) = 0                                     '报表行组织形式(0-居左 1-居中 2-居右)
    Call Scyxsjb(CxbbGrid)                               '生成报表数据
    Call Scdybb(Dyymctbl, Bbzbt, Bbxbt(), bbxbtzzxs(), Bbxbtgs, Bbbwh(), Bbbwhzzxs(), Bbbwhgs, bbylte)
    If Not bbylte Then
        Unload DY_Tybbyldy
    End If
End Sub