VB开发的ERP系统

VERSION 5.00
Begin VB.Form YM_FrmNmjz 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "年末结帐"
   ClientHeight    =   2370
   ClientLeft      =   2760
   ClientTop       =   3750
   ClientWidth     =   4425
   Icon            =   "月末结帐_年末结帐.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   2370
   ScaleWidth      =   4425
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  '屏幕中心
   Begin VB.CommandButton Command1 
      Caption         =   "关闭(&C)"
      Height          =   300
      Left            =   3000
      TabIndex        =   1
      Top             =   1710
      Width           =   1120
   End
   Begin VB.CommandButton cmdExecute 
      Caption         =   "结帐(&E)"
      Height          =   300
      Left            =   1800
      TabIndex        =   0
      Top             =   1710
      Width           =   1120
   End
   Begin VB.Line Line1 
      Index           =   2
      X1              =   240
      X2              =   4110
      Y1              =   1260
      Y2              =   1260
   End
   Begin VB.Line Line2 
      BorderColor     =   &H00FFFFFF&
      Index           =   2
      X1              =   240
      X2              =   4170
      Y1              =   1290
      Y2              =   1290
   End
   Begin VB.Label Lab_jzyf 
      Caption         =   "2003年年末结帐"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00000000&
      Height          =   255
      Left            =   1290
      TabIndex        =   2
      Top             =   420
      Width           =   1845
   End
End
Attribute VB_Name = "YM_FrmNmjz"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'********************************************************************
'*    模 块 名 称 :年末结帐
'*    功 能 描 述 :执行年末的结帐
'*    程序员姓名  :奚俊峰
'*    最后修改人  :奚俊峰
'*    最后修改时间:2001-12-10
'*    备        注:
'********************************************************************

Dim Int_Year As Integer    '当前会计年度
Dim Ztxxrec As Recordset   '临时记录集
Const str_Info = "百利/ERP5.0-财务总帐"


Private Sub cmdExecute_Click()
    If Fun_JzCheck = True Then Unload Me
End Sub

Private Sub Command1_Click()
    Unload Me
End Sub

Private Sub Form_Activate()
    On Error GoTo ErrHandle
    Lab_jzyf.Caption = "年末结帐"
    
    '取出当前的会计期间
    Set Ztxxrec = Cw_DataEnvi.DataConnect.Execute("Select kjyear=isnull(max(kjyear),0) From gy_kjrlb Where Cwzzjzbz=1")
    If Ztxxrec(0) > 0 Then
        Int_Year = Ztxxrec("kjyear")
        Lab_jzyf.Caption = Trim(Str(Int_Year)) + "年末结帐"
    Else
        MsgBox "此时不能进行年末结帐!", vbInformation, str_Info
        Unload Me
        Exit Sub
    End If
    
ErrHandle:
    
End Sub

'月末结帐过程处理
Private Function Fun_JzCheck() As Boolean                         '月末结帐前检查
    Dim RecTemp As New ADODB.Recordset   '临时使用动态集
    Dim rs As Recordset
    Dim str_Sql As String
    Dim str_CurrentYear As String        '当前会计年
    Dim str_NextYear As String           '下一会计年
    
    str_CurrentYear = CStr(Int_Year)
    str_NextYear = CStr(Int_Year + 1)
    
    
    On Error GoTo ErrHandle
    Cw_DataEnvi.DataConnect.BeginTrans
    
    
    Set Ztxxrec = Cw_DataEnvi.DataConnect.Execute("Select * From gy_kjrlb Where Cwzzjzbz=1 and period=12 and kjyear=" & Int_Year)
    If Ztxxrec.EOF Then
        MsgBox Int_Year & "年12月未进行月末结帐!", vbCritical, str_Info
        Cw_DataEnvi.DataConnect.RollbackTrans
        Exit Function
    End If
    
    Set Ztxxrec = Cw_DataEnvi.DataConnect.Execute("Select * From cwzz_accsum Where year=" & (Int_Year + 1))
    If Not Ztxxrec.EOF Then
        MsgBox Int_Year & "年末已经结帐!", vbInformation, str_Info
        Cw_DataEnvi.DataConnect.RollbackTrans
        Exit Function
    End If
    
    '检测是否存在当前会计日历表
    str_Sql = "select * from gy_kjrlb where kjyear='" & str_CurrentYear & "'"
    Set rs = Cw_DataEnvi.DataConnect.Execute(str_Sql)
    If rs.EOF Then
        MsgBox "请先设置" & str_CurrentYear & "年度的会计日历表!", vbInformation, str_Info
        Cw_DataEnvi.DataConnect.RollbackTrans
        Exit Function
    End If
    
    '设置总帐下年度的金额、数量、外币余额
    
    str_Sql = "insert into cwzz_accsum(ccode,year,period,ycye,ycsl,ycwb) " & _
    "select a.ccode,'" & str_NextYear & "',a.period," & _
    "ycye=(select b.qmye from cwzz_accsum b where b.period=12 and a.ccode=b.ccode and b.year='" & str_CurrentYear & "')," & _
    "ycsl=(select b.qmsl from cwzz_accsum b where b.period=12 and a.ccode=b.ccode and b.year='" & str_CurrentYear & "')," & _
    "ycwb=(select b.qmwb from cwzz_accsum b where b.period=12 and a.ccode=b.ccode and b.year='" & str_CurrentYear & "') " & _
    "From cwzz_accsum a " & _
    "where a.year='" & str_CurrentYear & "'"
    Cw_DataEnvi.DataConnect.Execute str_Sql
    
    str_Sql = "update cwzz_accsum set qcye=ycye,qmye=ycye,qcsl=ycsl,qmsl=ycsl,qcwb=ycwb,qmwb=ycwb where year='" & str_NextYear & "'"
    Cw_DataEnvi.DataConnect.Execute str_Sql
    
    '设置总帐辅助帐下年度的金额、数量、外币余额'
    Dim tStr As String
    tStr = "and isnull(a.personcode,'')=isnull(b.personcode,'') and isnull(a.deptcode,'') = isnull(b.deptcode,'') and isnull(a.cuscode,'') =isnull(b.cuscode,'') and isnull(a.suppliercode,'')=isnull(b.suppliercode,'') and isnull(a.itemclasscode,'')=isnull(b.itemclasscode,'') and isnull(a.itemcode,'')=isnull(b.itemcode,'')"
    
    str_Sql = "insert into cwzz_accsumassi(ccode,personcode,deptcode,cuscode,SupplierCode,itemclasscode,itemcode,year,period,ycye,ycsl,ycwb,ycitemsl) " & _
    "select ccode,personcode,deptcode,cuscode,SupplierCode,itemclasscode,itemcode,'" & str_NextYear & "',period," & _
    "ycye=(select b.qmye from cwzz_accsumassi b where b.period=12 and a.ccode=b.ccode and b.year='" & str_CurrentYear & "' " & tStr & ")," & _
    "ycsl=(select b.qmsl from cwzz_accsumassi b where b.period=12 and a.ccode=b.ccode and b.year='" & str_CurrentYear & "' " & tStr & ")," & _
    "ycwb=(select b.qmwb from cwzz_accsumassi b where b.period=12 and a.ccode=b.ccode and b.year='" & str_CurrentYear & "' " & tStr & ")," & _
    "ycitemsl=(select b.qmitemsl from cwzz_accsumassi b where b.period=12 and a.ccode=b.ccode and b.year='" & str_CurrentYear & "' " & tStr & ") " & _
    "From cwzz_accsumassi a " & _
    "where year='" & str_CurrentYear & "'"
    Cw_DataEnvi.DataConnect.Execute str_Sql
    
    str_Sql = "update cwzz_accsumassi set qcye=ycye,qmye=ycye,qcsl=ycsl,qmsl=ycsl,qcwb=ycwb,qmwb=ycwb,qcitemsl=ycitemsl,qmitemsl=ycitemsl where year='" & str_NextYear & "'"
    Cw_DataEnvi.DataConnect.Execute str_Sql
    
    str_Sql = "update Gy_AccInformation set ItemValue='0' where SystemCode='Cwzz' and ItemCode='Cwzz_Qclrwc'"
    Cw_DataEnvi.DataConnect.Execute str_Sql
    
    Cw_DataEnvi.DataConnect.CommitTrans
    
    MsgBox Int_Year & "年末结帐成功!", vbInformation, str_Info
    
    Fun_JzCheck = True
    Exit Function
ErrHandle:
    Fun_JzCheck = False
    Cw_DataEnvi.DataConnect.RollbackTrans
End Function