企业管理

开发平台：
Visual Basic

：源码内容
							VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form Oper_Depr 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "固定资产计提折旧"
   ClientHeight    =   2040
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   5370
   HelpContextID   =   504002
   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 QdCommand 
         Caption         =   "确定(&O)"
         Height          =   300
         Left            =   2100
         TabIndex        =   3
         Top             =   1470
         Width           =   1120
      End
      Begin VB.CommandButton QxCommand 
         Cancel          =   -1  'True
         Caption         =   "取消(&C)"
         Height          =   300
         Left            =   3360
         TabIndex        =   2
         Top             =   1470
         Width           =   1120
      End
      Begin MSComctlLib.ProgressBar Bar_Depr 
         Height          =   225
         Left            =   90
         TabIndex        =   1
         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          =   615
         Left            =   480
         TabIndex        =   4
         Top             =   330
         Width           =   4305
      End
   End
End
Attribute VB_Name = "Oper_Depr"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'**********************************************
'*    模 块 名 称 :固定资产计提折旧
'*    功 能 描 述 :
'*    程序员姓名  : 徐衍民
'*    最后修改人  : 徐衍民
'*    最后修改时间:2001/12/06
'*    备        注:
'**********************************************
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 String            '最大变动单号
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               '提示信息
Dim job_temp 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) + "月折旧?"
        Tsxx = Tsxx + Chr(10) + Chr(10) + "(*1.本月工作量是否录入 2.资产增减变动是否完成)"
        Lbl_Clew.Caption = Tsxx
    End If
    rstemp.Close
    Set rstemp = Nothing
    
End Sub
Private Sub QdCommand_Click()   '确定
    
    On Error GoTo Cwcl
    Cw_DataEnvi.DataConnect.BeginTrans
    
    '固定资产计提折旧
    Dim i As Integer
    
    i = 1
    Set RecTemp = New ADODB.Recordset
    Card_Str = "SELECT Gdzc_Card.* FROM Gdzc_Card LEFT OUTER JOIN Gdzc_State ON Gdzc_Card.FAStateCode = Gdzc_State.FaStateCode WHERE Gdzc_Card.WhetherNew = '0' AND Gdzc_State.DeprFlag = '1' AND Gdzc_Card.FactValue >= Gdzc_Card.SalValue"
    RecTemp.Open Card_Str, Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
    While Not RecTemp.EOF
        Bar_Depr.Visible = True
        Bar_Depr.Min = 0
        Bar_Depr.Max = RecTemp.RecordCount
        
        FAStateCode = RecTemp!FAStateCode
        FASortCode = RecTemp!FASortCode
        DeptCode = RecTemp!DeptCode
        job_temp = RecTemp!DeprMethod
        CardCode = RecTemp!CardCode
        Call Depr
        Bar_Depr.Value = i
        RecTemp.MoveNext
        i = i + 1
    Wend
    RecTemp.Close
    Set RecTemp = Nothing
    
    '将新增资产的新增标志赋成不是新增
    Cw_DataEnvi.DataConnect.Execute ("update gdzc_Card set cardtype='0',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
'固定资产折旧
Function Depr()
    '计提折旧原则：
    '1.减少资产不再计提折旧
    '2.本月新增资产不提折旧
    '3.资产净值小于净残值不提折旧
    '4.当月折旧额大于资产净值-残值时,折旧额=资产净值-净残值
    '5.处于某不提折旧使用状况时,本月不提折旧
    '6.按不同折旧方法计提本期折旧
    '7.如果折旧金额为零,已计提折旧月份不变
    '8.当资产使用年限进入最后两年时，资产折旧额在两年内每月平均分摊
    '9.双倍余额法在满足下列条件时，改用直线法1折旧：
    '  当年按双倍余额法计算的折旧额≤（资产净值－净残值）÷剩余使用年限
    
    '修改资产卡片表
    Set Rs_Temp = New ADODB.Recordset
    If job_temp = "04" Then
        Sqlstr = "SELECT Gdzc_Card.*, Gdzc_JobQuantity.ActivitiesCurrently AS ActivitiesCurrently " _
            & "FROM Gdzc_Card LEFT OUTER JOIN Gdzc_JobQuantity ON Gdzc_Card.CardCode = Gdzc_JobQuantity.CardCode " _
            & "where Gdzc_Card.cardCode='" & Trim(CardCode) & "' and Gdzc_JobQuantity.[Year] =" & Val(YearTemp) & " AND Gdzc_JobQuantity.Period =" & Val(PeriodTemp)
    Else
        Sqlstr = "SELECT Gdzc_Card.* FROM Gdzc_Card where Gdzc_Card.cardCode='" & Trim(CardCode) & "'"
    End If
    Rs_Temp.Open Sqlstr, Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
    With Rs_Temp
        If Not .EOF Then
            DeprM = 0
            If !DeprMethod = "07" Then
                If Val(Val(!FAValue) * Val((1 - Val(2 / Val(!Useyears))) ^ (Val(deprmothes)  12)) * Val(2 / Val(!Useyears))) <= Val(Val(Val(!FactValue) - Val(SalValue)) / Val(Val(!Useyears) - Val(!deprmothes)  12)) Then
                    !DeprMethod = "02"
                End If
            End If
            If Val(Val(!Useyears) * 12 - Val(!deprmothes)) / 12 = 2 Then
                DeprM = Val(!FactValue) / 24
                !DeprMethod = "05"
            Else
                Select Case !DeprMethod
                    Case "01"   '不计提折旧：
                        
                    Case "02"   '直线法1：月折旧额＝净资产÷剩余使用年限÷12
                        DeprM = Val(!FactValue) / Val(Val(!Useyears) - Val(Val(!deprmothes) / 12)) / 12
                    Case "03"   '直线法2：月折旧额＝（资产原值－净残值）÷使用年限÷12
                        DeprM = Val(Val(!FAValue) - Val(!SalValue)) / Val(!Useyears) / 12
                    Case "04"   '工作量法：月折旧额＝本期工作量×［（资产原值－净残值）÷工作总量］
                        DeprM = Val(!ActivitiesCurrently) * Val(Val(Val(!FAValue) - Val(!SalValue)) / Val(!Activities))
                    Case "05"   '固定折旧额法：月折旧额＝资产原值×月折旧率
                        DeprM = !DeprValue
                    Case "06"   '年数总和法：月折旧额＝（资产原值－净残值）×｛（使用年限－折旧年限）÷［使用年限×（1＋使用年限）÷2］÷12｝
                        DeprM = Val(Val(!FAValue) - Val(!SalValue)) * Val(Val(Val(!Useyears) - Val(Val(!deprmothes)  12)) / Val(Val(!Useyears) * Val(1 + Val(!Useyears)) / 2) / 12)
                    Case "07"   '双倍余额法：月折旧额＝年初资产净值×（2÷使用年限）÷12
                        DeprM = Val(Val(!FAValue) * Val((1 - Val(2 / Val(!Useyears))) ^ (Val(deprmothes)  12)) * Val(2 / Val(!Useyears))) / 12
                End Select
            End If
            If DeprM > Val(Val(!FactValue) - Val(!SalValue)) Then
                DeprM = Val(Val(!FactValue) - Val(!SalValue))
            End If
            !DeprValue = Format(DeprM, "##0.00")
            !deprmothes = Val(!deprmothes) + 1
            !DeprSum = Format(Val(!DeprSum) + Val(DeprM), "##0.00")
            !FactValue = Format(Val(!FactValue) - Val(DeprM), "##0.00")
            !DeprFlag = True
            !whetherNew = !whetherNew
            DeprMethod = !DeprMethod
            Job = !Activities
            SalValue = !SalValue
            Quantity = !FAQuantity
            Useyears = !Useyears
            FAValue = !FAValue
            DeprSum = !DeprSum
            .Update
        End If
    End With
    Rs_Temp.Close
    Set Rs_Temp = Nothing
    
    '修改资产明细表
    Set Rs_Temp = New ADODB.Recordset
    Sqlstr = "select * from Gdzc_DetailedForm where CardCode='" & Trim(CardCode) & "' and Year=" & Trim(YearTemp) & " and Period=" & Trim(PeriodTemp)
    Rs_Temp.Open Sqlstr, Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
    If Not Rs_Temp.EOF Then
        Rs_Temp!FAValueEnd = FAValue
        Rs_Temp!DeprSumEnd = DeprSum
        Rs_Temp!DeprValue = Format(DeprM, "##0.00")
        Rs_Temp!DeprDate = Xtrq
        Rs_Temp.Update
    End If
    Rs_Temp.Close
    Set Rs_Temp = Nothing
        
    '修改资产汇总表
    Set Rs_Temp = New ADODB.Recordset
    Sqlstr = "select * from Gdzc_total where deptCode='" & Trim(DeptCode) & "' and FASortCode='" & Trim(FASortCode) & "' " _
        & "and Year=" & YearTemp & " and period=" & PeriodTemp
    Rs_Temp.Open Sqlstr, Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
    With Rs_Temp
        If Not .EOF Then
            !DeprSumEndM = Format(Val(!DeprSumEndM) + Val(DeprM), "##0.00")
            !DeprSumInM = Format(Val(!DeprSumInM) + Val(DeprM), "##0.00")
            .Update
        End If
    End With
    Rs_Temp.Close
    Set Rs_Temp = Nothing
    
    '生成资产变动记录
    Call Vari
    Set Rs_Temp = New ADODB.Recordset
    Sqlstr = "select * from Gdzc_Variation"
    Rs_Temp.Open Sqlstr, Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
    With Rs_Temp
        .AddNew
        .Fields("VariVouCode") = MaxCode                 '变动单号
        .Fields("CardCode") = Trim(CardCode)             '卡片编号
        .Fields("Year") = Trim(YearTemp)                 '会计年度
        .Fields("Period") = Trim(PeriodTemp)             '会计期间
        .Fields("FAVariCode") = "00501"                     '资产变动(变动方式为“00501”时，专指资产累计折旧)
        .Fields("VariationReason") = "资产累计折旧"      '资产变动原因
        .Fields("DeptOld") = Trim(DeptCode)              '所属部门
        .Fields("FAStateOld") = Trim(FAStateCode)        '使用状况
        .Fields("DeprMethOld") = Trim(DeprMethod)        '折旧方法
        .Fields("FASortOld") = Trim(FASortCode)          '资产类别编号
        .Fields("FAValueOld") = CCur(FAValue)            '资产原值
        .Fields("ActivitiesOld") = Val(Job)              '工作总量
        .Fields("SalValueOld") = CCur(SalValue)          '净残值
        .Fields("UseYearsOld") = Val(Useyears)           '使用年限
        .Fields("FAQuantityOld") = Val(Quantity)         '资产数量
        .Fields("SumDeprOld") = Format(CCur(Val(DeprSum) - Val(DeprM)), "##0.00")         '资产累计折旧
        .Fields("DeptNew") = Trim(DeptCode)              '所属部门
        .Fields("FAStateNew") = Trim(FAStateCode)        '使用状况
        .Fields("DeprMethNew") = Trim(DeprMethod)        '折旧方法
        .Fields("FASortNew") = Trim(FASortCode)          '资产类别编号
        .Fields("FAValueNew") = CCur(FAValue)            '资产原值
        .Fields("SumDeprNew") = CCur(DeprSum)            '资产累计折旧
        .Fields("ActivitiesNew") = Val(Job)              '工作总量
        .Fields("SalValueNew") = CCur(SalValue)          '净残值
        .Fields("UseYearsNew") = Val(Useyears)           '使用年限
        .Fields("FAQuantityNew") = Val(Quantity)         '资产数量
        .Fields("Opreator") = Trim(Xtczy)                '操作员
        .Fields("VariDate") = Xtrq
        .Update
    End With
    Rs_Temp.Close
    Set Rs_Temp = Nothing
    
End Function
'变动单自动编号
Function Vari()
    
    Dim Max_Code As Double                              '最大值数值变量
    Set rstemp = New ADODB.Recordset
    rstemp.Open "select max(VariVouCode) as Max_CardCode from Gdzc_Variation", Cw_DataEnvi.DataConnect, adOpenKeyset, adLockOptimistic
    If Val(rstemp.Fields("Max_CardCode") & "") = 0 Then
        Max_Code = 1
    Else
        Max_Code = Val(rstemp.Fields("Max_CardCode")) + 1
    End If
    rstemp.Close
    Set rstemp = Nothing
    
    MaxCode = IIf(Max_Code < 10, "00000" & Max_Code, IIf(Max_Code < 100, "0000" & Max_Code, IIf(Max_Code < 1000, "000" & Max_Code, IIf(Max_Code < 10000, "00" & Max_Code, IIf(Max_Code < 100000, "0" & Max_Code, Max_Code)))))
End Function

						