VB开发的ERP系统

VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form Oper_CheckOut 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "月末结帐"
   ClientHeight    =   2040
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   5370
   HelpContextID   =   504004
   Icon            =   "月末结帐.frx":0000
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   2040
   ScaleWidth      =   5370
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  '屏幕中心
   Begin VB.Frame Frame1 
      Height          =   2025
      Left            =   0
      TabIndex        =   0
      Top             =   0
      Width           =   5355
      Begin VB.CommandButton QxCommand 
         Cancel          =   -1  'True
         Caption         =   "取消(&C)"
         Height          =   300
         Left            =   3360
         TabIndex        =   2
         Top             =   1470
         Width           =   1120
      End
      Begin VB.CommandButton QdCommand 
         Caption         =   "确定(&O)"
         Height          =   300
         Left            =   2100
         TabIndex        =   1
         Top             =   1470
         Width           =   1120
      End
      Begin MSComctlLib.ProgressBar Bar_Depr 
         Height          =   225
         Left            =   90
         TabIndex        =   3
         Top             =   1140
         Visible         =   0   'False
         Width           =   5145
         _ExtentX        =   9075
         _ExtentY        =   397
         _Version        =   393216
         Appearance      =   1
      End
      Begin VB.Label Lbl_Clew 
         Alignment       =   2  'Center
         ForeColor       =   &H00404040&
         Height          =   315
         Left            =   330
         TabIndex        =   4
         Top             =   570
         Width           =   4695
      End
   End
End
Attribute VB_Name = "Oper_CheckOut"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'**********************************************
'*    模 块 名 称 :固定资产计提折旧
'*    功 能 描 述 :
'*    程序员姓名  : 徐衍民
'*    最后修改人  : 徐衍民
'*    最后修改时间:2001/12/08
'*    备        注:
'**********************************************
Dim DeprM As Double              '月折旧额
Dim CardCode As String           '卡片编号
Dim Rs_Temp As ADODB.Recordset   '打开数据集变量
Dim rstemp As ADODB.Recordset    '打开数据集变量
Dim RecTemp As ADODB.Recordset   '打开数据集变量
Dim Sqlstr As String             '字符串变量
Dim Card_Str As String           '字符串变量
Dim YearTemp As Integer          '会计年度
Dim PeriodTemp As Integer        '会计期间
Dim FASortCode As String         '资产类别编号
Dim DeptCode As String           '部门编号
Dim FAValue As Double            '资产原值
Dim DeprSum As Double            '资产累计折旧
Dim MaxCode As Integer           '最大变动单号
Dim FAStateCode As String        '资产使用状况编号
Dim DeprMethod As String         '折旧方法
Dim Job As Double                '工作总量
Dim SalValue As Double           '净残值
Dim Quantity As Double           '资产数量
Dim Useyears As Double           '使用年限
Dim Tsxx As String               '提示信息

Private Sub Form_Load()          '窗体装入
    
    '显示提示内容
    Set rstemp = New ADODB.Recordset
    rstemp.Open "select top 1 * from gy_kjrlb where gdzcjzbz='0' ", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
    If Not rstemp.EOF Then
        YearTemp = rstemp!KjYear
        PeriodTemp = rstemp!Period
        Tsxx = "请确认是否开始" + Trim(YearTemp) + "年" + Mid(Trim(str(100 + PeriodTemp)), 2, 2) + "月月末结帐?"
        Lbl_Clew.Caption = Tsxx
    End If
    rstemp.Close
    Set rstemp = Nothing
    
End Sub

Private Sub QdCommand_Click()   '确定
    
    Dim i As Integer
    
    '本月未折旧不能月末结帐
    Set Rs_Temp = New ADODB.Recordset
    Rs_Temp.Open "select * from gdzc_card where DeprFlag='0' and [Check-outFlag]='0'", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
    If Not Rs_Temp.EOF Then
        Tsxx = "本月还未进行固定资产计提折旧,不能执行月末结帐!"
        Call Xtxxts(Tsxx, 0, 4)
        Unload Me
        Exit Sub
    End If
    Rs_Temp.Close
    Set Rs_Temp = Nothing
    
    On Error GoTo Cwcl
    Cw_DataEnvi.DataConnect.BeginTrans
    
    '结帐部分
    Lbl_Clew.Caption = "正在进行月末结帐,请稍候... "
    Lbl_Clew.FontSize = 15
    Lbl_Clew.ForeColor = &HC0&
    Lbl_Clew.FontName = "隶书"
    
    '追加资产资产明细表
    Set Rs_Temp = New ADODB.Recordset
    Sqlstr = "select * from Gdzc_DetailedForm where year=" & YearTemp & " and period=" & PeriodTemp
    Rs_Temp.Open Sqlstr, Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
    While Not Rs_Temp.EOF
        Set rstemp = New ADODB.Recordset
        rstemp.Open "select * from Gdzc_DetailedForm where 1=2", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
        With rstemp
            .AddNew
            !CardCode = Rs_Temp!CardCode
            !FASortCode = Rs_Temp!FASortCode
            If Val(Rs_Temp!Period) = 12 Then
                !Year = Val(Rs_Temp!Year) + 1
                !Period = 1
            Else
                !Year = Val(Rs_Temp!Year)
                !Period = Val(Rs_Temp!Period) + 1
            End If
            !FAValuestart = Rs_Temp!FAValueEnd
            !DeprSumStart = Rs_Temp!DeprSumEnd
            !DeprDate = Xtrq
            .Update
        End With
        rstemp.Close
        Set rstemp = Nothing
        Rs_Temp.MoveNext
    Wend
    Rs_Temp.Close
    Set Rs_Temp = Nothing
    
    '追加资产汇总表
    Set Rs_Temp = New ADODB.Recordset
    Sqlstr = "select * from Gdzc_total where year=" & YearTemp & " and period=" & PeriodTemp
    Rs_Temp.Open Sqlstr, Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
    While Not Rs_Temp.EOF
        Set rstemp = New ADODB.Recordset
        rstemp.Open "select * from Gdzc_total where 1=2", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
        With rstemp
            .AddNew
            !DeptCode = Rs_Temp!DeptCode
            !FASortCode = Rs_Temp!FASortCode
            If Val(Rs_Temp!Period) = 12 Then
                !Year = Val(Rs_Temp!Year) + 1
                !Period = 1
                !FAValueStartY = Rs_Temp!FAvalueEndM
                !DeprSumStartY = Rs_Temp!DeprSumEndM
            Else
                !Year = Val(Rs_Temp!Year)
                !Period = Val(Rs_Temp!Period) + 1
            End If
            !FAValueStartY = Val(Rs_Temp!FAValueStartY & "")
            !DeprSumStartY = Val(Rs_Temp!DeprSumStartY & "")
            !FAValueStartM = Rs_Temp!FAvalueEndM
            !DeprSumStartM = Rs_Temp!DeprSumEndM
            !FAvalueEndM = !FAValueStartM
            !DeprSumEndM = !DeprSumStartM
            .Update
        End With
        rstemp.Close
        Set rstemp = Nothing
        Rs_Temp.MoveNext
    Wend
    Rs_Temp.Close
    Set Rs_Temp = Nothing
    
    '追加工作量表记录
    Set Rs_Temp = New ADODB.Recordset
    Sqlstr = "select * from Gdzc_JobQuantity where year=" & YearTemp & " and period=" & PeriodTemp
    Rs_Temp.Open Sqlstr, Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
    While Not Rs_Temp.EOF
        Set rstemp = New ADODB.Recordset
        rstemp.Open "select * from Gdzc_JobQuantity where 1=2", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
        With rstemp
            .AddNew
            !CardCode = Rs_Temp!CardCode
            If Val(Rs_Temp!Period) = 12 Then
                !Year = Val(Rs_Temp!Year) + 1
                !Period = 1
            Else
                !Year = Val(Rs_Temp!Year)
                !Period = Val(Rs_Temp!Period) + 1
            End If
            !ActivitiesStart = Rs_Temp!AcivitiesAEnd
            !AcivitiesAEnd = Rs_Temp!AcivitiesAEnd
            !AcivitiesUnit = Rs_Temp!AcivitiesUnit
            .Update
        End With
        rstemp.Close
        Set rstemp = Nothing
        Rs_Temp.MoveNext
    Wend
    Rs_Temp.Close
    Set Rs_Temp = Nothing
    
    '将固定资产月末结帐标志赋成已结帐
    Set rstemp = New ADODB.Recordset
    rstemp.Open "select top 1 * from gy_kjrlb where gdzcjzbz='0'", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
    If Not rstemp.EOF Then
        rstemp.Fields("gdzcjzbz") = True
        rstemp.Update
    End If
    rstemp.Close
    Set rstemp = Nothing
    
    '将资产卡片的结帐标志赋成未折旧和未结帐
    Cw_DataEnvi.DataConnect.Execute ("update gdzc_card set deprflag='0' where deprflag='1'")
    
    Cw_DataEnvi.DataConnect.CommitTrans
    Tsxx = "本月月末结帐完毕!"
    Call Xtxxts(Tsxx, 0, 4)
    Unload Me
    Exit Sub
Cwcl:
    Cw_DataEnvi.DataConnect.RollbackTrans
    Tsxx = "计提折旧过程中出现未知错误,程序自动恢复折旧前状态!"
    Call Xtxxts(Tsxx, 0, 1)
    Exit Sub
    
End Sub

Private Sub QxCommand_Click()   '取消
    Unload Me
End Sub