企业管理

开发平台：
Visual Basic

˪-i_：源码内容
							VERSION 5.00
Begin VB.Form RP_FrmYmjz 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "月末结帐"
   ClientHeight    =   2025
   ClientLeft      =   2760
   ClientTop       =   3750
   ClientWidth     =   4515
   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     =   2025
   ScaleWidth      =   4515
   ShowInTaskbar   =   0   'False
   StartUpPosition =   1  '所有者中心
   Begin VB.CheckBox chkVouch 
      Caption         =   "存在未生成凭证的单据时,是否执行月末结帐"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   285
      Left            =   330
      TabIndex        =   3
      Top             =   780
      Width           =   3855
   End
   Begin VB.CommandButton cmdExecute 
      Caption         =   "结帐(&E)"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   300
      Left            =   1890
      TabIndex        =   1
      Top             =   1530
      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            =   3090
      TabIndex        =   0
      Top             =   1530
      Width           =   1120
   End
   Begin VB.Label labTitle 
      Caption         =   "2002年01月月末结帐"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00000000&
      Height          =   225
      Left            =   1140
      TabIndex        =   2
      Top             =   150
      Width           =   2355
   End
   Begin VB.Line Line2 
      BorderColor     =   &H00FFFFFF&
      Index           =   2
      X1              =   330
      X2              =   4260
      Y1              =   1290
      Y2              =   1290
   End
   Begin VB.Line Line1 
      Index           =   2
      X1              =   330
      X2              =   4200
      Y1              =   1260
      Y2              =   1260
   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-应收系统"
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()
    If chkVouch.Value = 1 Then
        If CheckVouch = False Then
            MsgBox Int_Year & "年" & Int_Period & "月存在未生成凭证的单据," & vbCrLf & "不能执行月末结帐!", vbInformation, 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 CheckVouch() As Boolean
    Dim Rs As Recordset
    Dim str_Sql As String
    
    str_Sql = "select count(*) from RP_AccList where Kjyear=" & Int_Year & " and Period=" & Int_Period & " and VouchId=0 and RpFlag='" & RPFlag & "'"
    Set Rs = Cw_DataEnvi.DataConnect.Execute(str_Sql)
    If Rs(0) > 0 Then
        CheckVouch = False
    Else
        CheckVouch = True
    End If
End Function

						