VB开发的ERP系统

    Lab_jzyf.Caption = Trim(Str(Dqkjyear)) + "年" + Mid(Trim(Str(100 + Dqkjmm)), 2, 2) + "月月末结帐"
    
    '判断是否已结帐
    If int_BookFlag = 1 Then
        lab_NotBookInfor.Caption = "提示:" & Trim(Str(Dqkjyear)) + "年" + Mid(Trim(Str(100 + Dqkjmm)), 2, 2) + "月已结帐,请核实!"
        lab_NotBookInfor.Visible = True
        cmdNext1.Enabled = False
    End If
    
    
    
    '调入打印页面设置窗体
    XtReportCode = "Cwzz_ymjz"
    Load Dyymctbl
    ReportTitle = "帐目对帐结果"
    
    '调 入 网 格
    GridCode = "Cwzz_ymjz"
    Call BzWgcsh(CxbbGrid, GridCode, GridInf(), GridBoolean(), GridInt(), GridStr())
    
    Qslz = GridInf(1)
    Sjhgd = GridInf(2)
    Sfxshjwg = GridInf(7)
    Szzls = CxbbGrid.Cols - 1
    cmdNext1.Enabled = False
    
    Timer2.Enabled = True
End Sub

'月末结帐过程处理
Private Function Fun_JzCheck() As Boolean                         '月末结帐前检查
    Dim rs As Recordset
    Dim str_Sql As String
    
    '判断是否试算平衡、对帐正确
    If Int_SS_OK = 0 Or Int_DZ_OK = 0 Then
        If MsgBox("试算不平衡或对帐不正确,确实要进行吗?", vbQuestion + vbYesNo, str_Info) = vbNo Then
            Cw_DataEnvi.DataConnect.RollbackTrans
            Exit Function
        End If
    End If
    
    On Error GoTo ErrHandle
    Cw_DataEnvi.DataConnect.BeginTrans
    
    
    If Int_Period = 1 Then
        str_Sql = "select * from cwzz_accsum where year=" & Int_Year
        Set rs = Cw_DataEnvi.DataConnect.Execute(str_Sql)
        If rs.EOF Then
            Cw_DataEnvi.DataConnect.RollbackTrans
            MsgBox "先进行" & (Int_Year - 1) & "年末结帐!", vbInformation, str_Info
            Exit Function
        End If
    End If
    
    
    '置本会计期间结帐标识为 1
    Cw_DataEnvi.DataConnect.Execute ("update gy_kjrlb set Cwzzjzbz=1 where kjYear=" & Dqkjyear & "and  period=" & Dqkjmm)
    
    Cw_DataEnvi.DataConnect.CommitTrans
    Fun_JzCheck = True
    Exit Function
ErrHandle:
    Fun_JzCheck = False
    Cw_DataEnvi.DataConnect.RollbackTrans
End Function


'试算平衡处理
Private Sub Sub_PingHeng()
    Dim Dbl_Qcye(4) As Double              '各类科目期初数据
    Dim Dbl_ZcQcye As Double               '资产类科目数据合计
    Dim Dbl_FzQcye As Double               '负债及所有者权益类科目数据合计
    Dim Sqlstr As String                   '查询字符串
    Dim RecTemp As New ADODB.Recordset     '临时使用动态集
    
    
    Sqlstr = "SELECT Cwzz_AccCode.CClass, SUM(Cwzz_AccSum.Qmye) AS QcyeHj" & _
    " FROM Cwzz_AccSum LEFT OUTER JOIN Cwzz_AccCode ON Cwzz_AccSum.Ccode = Cwzz_AccCode.Ccode" & _
    " Where Cwzz_AccCode.EndFlag=1 And Year=" & Int_Year & " And Period=" & Int_Period & " GROUP BY Cclass"
    Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
    
    With RecTemp
        
        Do While Not .EOF
            
            Select Case Trim(.Fields("Cclass"))
            Case "资产"
                Dbl_Qcye(0) = .Fields("Qcyehj")
            Case "负债"
                Dbl_Qcye(1) = .Fields("Qcyehj")
            Case "所有者权益"
                Dbl_Qcye(2) = .Fields("Qcyehj")
            Case "成本"
                Dbl_Qcye(3) = .Fields("Qcyehj")
            Case "损益"
                Dbl_Qcye(4) = .Fields("Qcyehj")
            End Select
            
            .MoveNext
        Loop
        
    End With
    
    '显示数据
    For Jsqte = 0 To 4
        If Dbl_Qcye(Jsqte) > 0 Then
            Lab_Qcyesj(Jsqte).Caption = "借" & " " & Format(Dbl_Qcye(Jsqte), "##." + String(Xtjexsws, "0"))
        Else
            If Dbl_Qcye(Jsqte) = 0 Then
                Lab_Qcyesj(Jsqte).Caption = "平"
            Else
                Lab_Qcyesj(Jsqte).Caption = "贷" & " " & Format(-Dbl_Qcye(Jsqte), "##." + String(Xtjexsws, "0"))
            End If
        End If
    Next Jsqte
    
    '显示(资产+成本)合计数据
    
    Dbl_ZcQcye = Dbl_Qcye(0) + Dbl_Qcye(3)
    Dbl_FzQcye = Dbl_Qcye(1) + Dbl_Qcye(2) + Dbl_Qcye(4)
    
    If Dbl_ZcQcye > 0 Then
        Lab_Qcyesj(5).Caption = "借" & " " & Format(Dbl_ZcQcye, "##." + String(Xtjexsws, "0"))
    Else
        If Dbl_ZcQcye = 0 Then
            Lab_Qcyesj(5).Caption = "平"
        Else
            Lab_Qcyesj(5).Caption = "贷" & " " & Format(-Dbl_ZcQcye, "##." + String(Xtjexsws, "0"))
        End If
    End If
    
    If Dbl_FzQcye > 0 Then
        Lab_Qcyesj(6).Caption = "借" & " " & Format(Dbl_FzQcye, "##." + String(Xtjexsws, "0"))
    Else
        If Dbl_FzQcye = 0 Then
            Lab_Qcyesj(6).Caption = "平"
        Else
            Lab_Qcyesj(6).Caption = "贷" & " " & Format(-Dbl_FzQcye, "##." + String(Xtjexsws, "0"))
        End If
    End If
    
    '判断试算是否平衡
    If Format(Dbl_ZcQcye + Dbl_FzQcye, "0.00") = 0 Then
        Lab_Phjg.ForeColor = vbBlue
        Lab_Phjg.Caption = "试算结果:平衡"
        
        lab_SSPH.ForeColor = vbBlue
        lab_SSPH.Caption = "试算结果:平衡"
        Int_SS_OK = 1
    Else
        Lab_Phjg.ForeColor = vbRed
        Lab_Phjg.Caption = "试算结果:不平衡"
        
        lab_SSPH.ForeColor = vbRed
        lab_SSPH.Caption = "试算结果:不平衡"
        Int_SS_OK = 0
    End If
    
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 Timer1_Timer()
    Timer1.Enabled = False
    cmdDuiZhang_Click
End Sub

Private Sub Timer2_Timer()
    Dim str_Sql As String
    Dim RecTemp As Recordset
    Dim int_Count As Long
    
    Timer2.Enabled = False
    
    '判断是否有未记帐凭证
    str_Sql = "select a.ddate,b.digest,a.bill from cwzz_accvouchmain a,cwzz_accvouchsub b where a.vouchid=b.vouchid and a.Year=" & Dqkjyear & " And a.Period=" & Dqkjmm & " And a.BookFlag=0 order by a.ddate"
    Set RecTemp = Cw_DataEnvi.DataConnect.Execute(str_Sql)
    If Not RecTemp.EOF Then
        Do While Not RecTemp.EOF
            int_Count = int_Count + 1
            lst_NotBook.ListItems.Add , , CStr(Trim(RecTemp(0) & ""))
            lst_NotBook.ListItems(int_Count).ListSubItems.Add , , CStr(Trim(RecTemp(1) & ""))
            lst_NotBook.ListItems(int_Count).ListSubItems.Add , , CStr(Trim(RecTemp(2) & ""))
            RecTemp.MoveNext
        Loop
        lab_NotBookInfor.Visible = True
        lst_NotBook.Visible = True
        cmdNext1.Enabled = False
    Else
        cmdNext1.Enabled = True
    End If
    labState.Visible = False
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
        Int_DZ_OK = 1
    Else
        Int_DZ_OK = 0
    End If
    
    For Int_CheckSele = 1 To 5
        If Fun_HdZzFzz(Int_CheckSele) Then
            Lab_CheckJg(Int_CheckSele).Visible = True
            Int_DZ_OK = IIf(Int_DZ_OK = 1, 1, 0)
        Else
            Int_DZ_OK = 0
        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