📄
字号:
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
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -