企业管理

开发平台：
Visual Basic

˪-i_：源码内容
							VERSION 5.00
Begin VB.Form RP_FrmYmjz 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "月末结帐"
   ClientHeight    =   1650
   ClientLeft      =   2760
   ClientTop       =   3750
   ClientWidth     =   4440
   BeginProperty Font 
      Name            =   "宋体"
      Size            =   10.5
      Charset         =   134
      Weight          =   700
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   Icon            =   "应收_月末结帐.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   1650
   ScaleWidth      =   4440
   ShowInTaskbar   =   0   'False
   StartUpPosition =   1  '所有者中心
   Begin VB.CommandButton cmdExecute 
      Caption         =   "确定(&O)"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   300
      Left            =   2010
      TabIndex        =   1
      Top             =   1260
      Width           =   1120
   End
   Begin VB.CommandButton cmdClose 
      Caption         =   "取消(&C)"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   300
      Left            =   3210
      TabIndex        =   0
      Top             =   1260
      Width           =   1120
   End
   Begin VB.Label labTitle 
      Caption         =   "月末结帐"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00000000&
      Height          =   225
      Left            =   600
      TabIndex        =   2
      Top             =   480
      Width           =   3555
   End
End
Attribute VB_Name = "RP_FrmYmjz"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'********************************************************************
'*    模 块 名 称 :月末结帐(应收、应付)
'*    功 能 描 述 :执行月末的结帐
'*    程序员姓名  :奚俊峰
'*    最后修改人  :
'*    最后修改时间:2002-01-18
'*    备        注:
'********************************************************************
Dim Int_Year As Integer     '当前会计年度
Dim Int_Period As Integer   '当前会计期间
Const RPField = "ApJzbz"
Const RPFlag = "AP"
Const RPTitle = "百利/ERP5.0-应付系统"
Const RPFinishParaName = "Ap_CshWbBs"
Const RPAfterVouchName = "Ap_IsSettleAfterVouch"
Const RPCheckFlag = "A2"
Private Sub Form_Load()
    Dim Rs As Recordset
        
    Set Rs = Cw_DataEnvi.DataConnect.Execute("Select top 1 * From gy_kjrlb Where " & RPField & "=0 Order by kjyear,period")
    With Rs
        If Not .EOF Then
            Int_Year = .Fields("kjyear")
            Int_Period = .Fields("period")
        End If
    End With
    
   labTitle.Caption = "请确认是否执行" & Trim(Str(Int_Year)) + "年" + Mid(Trim(Str(100 + Int_Period)), 2, 2) + "月月末结帐?"
    
End Sub
'关闭窗体
Private Sub cmdClose_Click()
    Unload Me
End Sub
'执行结帐
Private Sub cmdExecute_Click()
    Dim tStr As String
    
    If IsFinish = False Then
        MsgBox "初始化没有完成,不能月末结帐!", vbCritical, RPTitle
        Exit Sub
    End If
   
    tStr = IsCheck
    If tStr <> "" Then
        MsgBox tStr, vbCritical, RPTitle
        Exit Sub
    End If
    
    If IsContinueFlag = True Then
        tStr = CheckVouch
        If tStr <> "" Then
            MsgBox tStr, vbCritical, RPTitle
            Exit Sub
        End If
    End If
    If Fun_JzCheck = True Then Unload Me
End Sub
'月末结帐过程处理
Private Function Fun_JzCheck() As Boolean                         '月末结帐前检查
    Dim RecTemp As New ADODB.Recordset   '临时使用动态集
    Dim Rs As Recordset
    Dim str_Sql As String
    Dim int_NextYear As String           '下一会计年
    Dim int_NextPeriod As Integer
    
    str_CurrentYear = CStr(Int_Year)
    If Int_Period = 12 Then
        int_NextYear = Int_Year + 1
        int_NextPeriod = 1
    Else
        int_NextYear = Int_Year
        int_NextPeriod = Int_Period + 1
    End If
    
    On Error GoTo ErrHandle
    Cw_DataEnvi.DataConnect.BeginTrans
    
    If Int_Period = 12 Then
        '检测是否存在当前会计日历表
        str_Sql = "select * from gy_kjrlb where kjyear='" & int_NextYear & "'"
        Set Rs = Cw_DataEnvi.DataConnect.Execute(str_Sql)
        If Rs.EOF Then
            MsgBox "请先设置" & int_NextYear & "年度的会计日历表!", vbInformation, RPTitle
            Cw_DataEnvi.DataConnect.RollbackTrans
            Exit Function
        End If
    End If
    
    '设置总帐下期间的金额、数量、外币余额
    If Int_Period = 12 Then
        str_Sql = "insert into Rp_AccSum(RpFlag,PsCode,DeptCode,PersonCode,ForeignCurrCode,KjYear,Period,YbNcye,YbQcye,YbYsje,YbSsje,YbQmye,BbNcye,BbQcye,BbYsje,BbSsje,BbQmye) " & _
        "select a.RpFlag,a.PsCode,a.DeptCode,a.PersonCode,a.ForeignCurrCode,'" & int_NextYear & "','" & int_NextPeriod & "'," & _
        "a.YbQmye,a.YbQmye,0,0,a.YbQmye,a.BbQmye,a.BbQmye,0,0,a.BbQmye " & _
        "From Rp_AccSum a " & _
        "where a.Kjyear='" & Int_Year & "' and a.Period='" & Int_Period & "' and a.RpFlag='" & RPFlag & "'" & _
        "order by AccSumId"
    Else
        str_Sql = "insert into Rp_AccSum(RpFlag,PsCode,DeptCode,PersonCode,ForeignCurrCode,KjYear,Period,YbNcye,YbQcye,YbYsje,YbSsje,YbQmye,BbNcye,BbQcye,BbYsje,BbSsje,BbQmye) " & _
        "select a.RpFlag,a.PsCode,a.DeptCode,a.PersonCode,a.ForeignCurrCode,'" & int_NextYear & "','" & int_NextPeriod & "'," & _
        "a.YbNcye,a.YbQmye,0,0,a.YbQmye,a.BbNcye,a.BbQmye,0,0,a.BbQmye " & _
        "From Rp_AccSum a " & _
        "where a.Kjyear='" & Int_Year & "' and a.Period='" & Int_Period & "' and a.RpFlag='" & RPFlag & "'" & _
        "order by AccSumId"
    End If
    Cw_DataEnvi.DataConnect.Execute str_Sql
    
    str_Sql = "update gy_kjrlb set " & RPField & "=1 where kjyear='" & Int_Year & "' and period='" & Int_Period & "'"
    
    Cw_DataEnvi.DataConnect.Execute str_Sql
    
    Cw_DataEnvi.DataConnect.CommitTrans
    
    MsgBox Int_Year & "年" & Int_Period & "月末结帐成功!", vbInformation, RPTitle
    
    Fun_JzCheck = True
    Exit Function
ErrHandle:
    Fun_JzCheck = False
    Cw_DataEnvi.DataConnect.RollbackTrans
    MsgBox "月末结帐出现意外错误,请重试!", vbCritical, RPTitle
End Function
'是否初始化完成
Function IsFinish() As Boolean
    Dim Rs As Recordset
    Dim str_Sql As String
    
    str_Sql = "select isnull(ItemValue,'') from Gy_AccInformation where ItemCode='" & RPFinishParaName & "'"
    Set Rs = Cw_DataEnvi.DataConnect.Execute(str_Sql)
    
    If Rs.EOF Then Exit Function
    
    If Val(Rs(0)) = 0 Then
        IsFinish = False
    Else
        IsFinish = True
    End If
End Function
'当存在未生成凭证的单据时,是否可以继续月末结帐
Function IsContinueFlag() As Boolean
    Dim Rs As Recordset
    Dim str_Sql As String
    
    str_Sql = "select isnull(ItemValue,'') from Gy_AccInformation where ItemCode='" & RPAfterVouchName & "'"
    Set Rs = Cw_DataEnvi.DataConnect.Execute(str_Sql)
    
    If Rs.EOF Then Exit Function
    
    If Val(Rs(0)) = 0 Then
        IsContinueFlag = False
    Else
        IsContinueFlag = True
    End If
End Function
'判断是否本期单据已全部审核
Function IsCheck() As String
    Dim Rs As Recordset
    Dim str_Sql As String
    Dim str_Result As String
    
    str_Sql = "select CloseBill=(select count(*) from RP_CloseBill where Kjyear=" & Int_Year & " and Period=" & Int_Period & " and isnull(Checker,'')='' and RpFlag='" & RPFlag & "')," & _
                     "Note=(select count(*) from RP_Note where Kjyear=" & Int_Year & " and Period=" & Int_Period & " and isnull(Checker,'')='' and RpFlag='" & RPFlag & "')," & _
                     "OtherBill=(select count(*) from RP_OtherBill where Kjyear=" & Int_Year & " and Period=" & Int_Period & " and isnull(Checker,'')='' and RpFlag='" & RPFlag & "')"
    Set Rs = Cw_DataEnvi.DataConnect.Execute(str_Sql)
    
    If Rs("CloseBill") > 0 Then
        str_Result = "RP_CloseBill存在未审核单据,"
    End If
    
    If Rs("Note") > 0 Then
        str_Result = str_Result & vbCrLf & "RP_Note存在未审核单据,"
    End If
    
    If Rs("OtherBill") > 0 Then
        str_Result = str_Result & vbCrLf & "RP_OtherBill存在未审核单据,"
    End If
    
    If str_Result = "" Then
        IsCheck = ""
    Else
        str_Result = Left(str_Result, Len(str_Result) - 1) & "!"
        IsCheck = "系统存在未审核单据!"
    End If
End Function
'检查当前期间是否有未生成凭证的单据
Function CheckVouch() As String
    Dim Rs As Recordset
    Dim str_Sql As String
    Dim str_Result As String
    
    str_Sql = "select AccList=(select count(*) from RP_AccList where Kjyear=" & Int_Year & " and Period=" & Int_Period & " and VouchId=0 and StartFlag=0 and RpFlag='" & RPFlag & "')," & _
                     "Cancel=(select count(*) from RP_Cancel where CancelItemCode='" & RPCheckFlag & "' and  VouchId=0 and RpFlag='" & RPFlag & "')," & _
                     "Note=(select count(*) from RP_Note where Kjyear=" & Int_Year & " and Period=" & Int_Period & " and VouchId=0 and StartFlag=0 and RpFlag='" & RPFlag & "')," & _
                     "NoteClose=(select count(*) from RP_NoteClose where Kjyear=" & Int_Year & " and Period=" & Int_Period & " and VouchId=0 and RpFlag='" & RPFlag & "')"
    Set Rs = Cw_DataEnvi.DataConnect.Execute(str_Sql)
    
    If Rs("AccList") > 0 Then
        str_Result = "RP_AccList存在未生成凭证的单据,"
    End If
    
    If Rs("Cancel") > 0 Then
        str_Result = str_Result & vbCrLf & "RP_Cancel存在未生成凭证的单据,"
    End If
    
    If Rs("Note") > 0 Then
        str_Result = str_Result & vbCrLf & "RP_Note存在未生成凭证的单据,"
    End If
    
    If Rs("NoteClose") > 0 Then
        str_Result = str_Result & vbCrLf & "RP_NoteClose存在未生成凭证的单据,"
    End If
    If str_Result = "" Then
        CheckVouch = ""
    Else
        str_Result = Left(str_Result, Len(str_Result) - 1) & "!"
        CheckVouch = "系统存在未生成凭证的单据!"
    End If
End Function

						