开通博客赚积分
发布资源赚积分
分类

源码开发语言/平台
当前位置：首页 > 源码/资料 > 行业应用 > 企业管理 > 查看源码
资源名称：ERPSYS.zip　[点击查看]
上传用户：zhpu1995
上传日期：2013-09-06
资源大小：61151k
文件大小：146k
源码类别：

企业管理

开发平台：

Visual Basic

：源码内容
  1.       Left            =   0
  2.       TabIndex        =   122
  3.       Top             =   0
  4.       Width           =   9510
  5.       _ExtentX        =   16775
  6.       _ExtentY        =   979
  7.       ButtonWidth     =   820
  8.       ButtonHeight    =   926
  9.       AllowCustomize  =   0   'False
  10.       Appearance      =   1
  11.       Style           =   1
  12.       ImageList       =   "ImageList1"
  13.       _Version        =   393216
  14.       BeginProperty Buttons {66833FE8-8583-11D1-B16A-00C0F0283628} 
  15.          NumButtons      =   14
  16.          BeginProperty Button1 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  17.             Caption         =   "新增"
  18.             Key             =   "zj"
  19.             ImageKey        =   "xz"
  20.          EndProperty
  21.          BeginProperty Button2 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  22.             Caption         =   "修改"
  23.             Key             =   "xg"
  24.             ImageKey        =   "xg"
  25.          EndProperty
  26.          BeginProperty Button3 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  27.             Caption         =   "删除"
  28.             Key             =   "sc"
  29.             ImageKey        =   "sc"
  30.          EndProperty
  31.          BeginProperty Button4 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  32.             Style           =   4
  33.          EndProperty
  34.          BeginProperty Button5 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  35.             Caption         =   "保存"
  36.             Key             =   "bc"
  37.             ImageKey        =   "bc"
  38.          EndProperty
  39.          BeginProperty Button6 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  40.             Caption         =   "放弃"
  41.             Key             =   "fq"
  42.             ImageKey        =   "fq"
  43.          EndProperty
  44.          BeginProperty Button7 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  45.             Style           =   4
  46.          EndProperty
  47.          BeginProperty Button8 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  48.             Caption         =   "首张"
  49.             Key             =   "first"
  50.             ImageKey        =   "first"
  51.          EndProperty
  52.          BeginProperty Button9 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  53.             Caption         =   "上张"
  54.             Key             =   "prev"
  55.             ImageKey        =   "prev"
  56.          EndProperty
  57.          BeginProperty Button10 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  58.             Caption         =   "下张"
  59.             Key             =   "next"
  60.             ImageKey        =   "next"
  61.          EndProperty
  62.          BeginProperty Button11 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  63.             Caption         =   "末张"
  64.             Key             =   "last"
  65.             ImageKey        =   "last"
  66.          EndProperty
  67.          BeginProperty Button12 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  68.             Style           =   4
  69.          EndProperty
  70.          BeginProperty Button13 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  71.             Caption         =   "帮助"
  72.             Key             =   "bz"
  73.             ImageKey        =   "bz"
  74.          EndProperty
  75.          BeginProperty Button14 {66833FEA-8583-11D1-B16A-00C0F0283628} 
  76.             Caption         =   "退出"
  77.             Key             =   "fh"
  78.             ImageKey        =   "tc"
  79.          EndProperty
  80.       EndProperty
  81.       BorderStyle     =   1
  82.    End
  83. End
  84. Attribute VB_Name = "Kpgl_jbcz"
  85. Attribute VB_GlobalNameSpace = False
  86. Attribute VB_Creatable = False
  87. Attribute VB_PredeclaredId = True
  88. Attribute VB_Exposed = False
  89. '******************************************************************
  90. '*    模 块 名 称 :资产卡片录入
  91. '*    功 能 描 述 :
  92. '*    程序员姓名  :徐衍民
  93. '*    最后修改人  :徐衍民
  94. '*    最后修改时间:2001/11/27
  95. '*    备        注:
  96. '******************************************************************
  97. Dim Tsxx As String                       '系统信息提示
  98. Dim rstemp As ADODB.Recordset            '打开数据集变量
  99. Dim MaxCode As String                    '最大值字符串变量
  100. Dim Ccur_bit As Boolean                  '币种本位币计算公式
  101. Public str_State As String               '文本框编辑状态
  102. Public str_CardNumber As String          '卡片编号
  103. Dim Str_RightEdit As String              '编辑(新增、修改、删除)权限索引
  105. '以下为固定使用变量(文本框)
  106. Dim Textvar() As Variant                 '存储变体型文本框信息
  107. Dim Textboolean() As Boolean             '存储布尔型文本框信息
  108. Dim Textint() As Integer                 '存储整型文本框信息
  109. Dim Textstr() As String                  '存储字符型文本框信息
  110. Dim Max_Text_Index As Integer            '最大录入文本框索引值
  111. Dim TextGroupCode As String              '文本框录入分组编码
  112. Dim TextValiLock As Boolean              '文本框失去焦点是否进行有效性控制判断
  113. Dim TextValiJudgeLock() As Boolean       '文本框录入有效性判断控制锁
  114. Dim CurTextIndex As Integer              '当前文本框索引值
  115. Dim TextChangeLock As Boolean            '文本框内容变换控制锁
  116. Dim Bln_Cancel As Boolean                '取消按钮信息传递
  118. Private Sub Form_KeyPress(KeyAscii As Integer)   '控 制 焦 点 转 移
  119.     
  120.     Dim jdzygs As Integer                         '控件焦点转移个数
  121.     jdzygs = 52
  122.     Select Case KeyAscii
  123.         Case vbKeyReturn
  124.             If Kjjdzy(jdzygs) Then
  125.                 KeyAscii = 0
  126.             End If
  127.         Case 39           '屏蔽"'"
  128.             KeyAscii = 0
  129.     End Select
  131. End Sub
  133. Private Sub Form_Load()
  134.     
  135.     '以下为文本框处理程序
  136.     TextGroupCode = "Gdzc_CardJbcz"
  137.     Call Drwbkxx(TextGroupCode, Textvar(), Textboolean(), Textint(), Textstr())  '读入文本框录入信息
  138.     Call Wbkcsh
  139.     
  140.     SSTab1.Tab = 0
  141.     
  142.     Me.AutoRedraw = False
  143.     
  144.     Num_text.Text = str_CardNumber
  145.     
  146.     SetToolState
  147.     
  148.     '编辑(新增、修改、删除)权限索引
  149.     Str_RightEdit = "Gdzc_Jbcz_Edit"
  150.     
  151. End Sub
  153. '*******************以下区域为编写自定义过程区域**********************
  154. '设置工具栏按钮状态
  155. Private Sub SetToolState()
  157.     If Me.AutoRedraw = False Then
  158.         If Trim(str_State) = "1" Then
  159.             SzToolbar.Buttons("xg").Enabled = False
  160.             SzToolbar.Buttons("sc").Enabled = False
  161.             SzToolbar.Buttons("bc").Enabled = True
  162.             SzToolbar.Buttons("fq").Enabled = True
  163.             SzToolbar.Buttons("first").Enabled = False
  164.             SzToolbar.Buttons("prev").Enabled = False
  165.             SzToolbar.Buttons("next").Enabled = False
  166.             SzToolbar.Buttons("last").Enabled = False
  167.             Call Open_Lock
  168.             Me.AutoRedraw = True
  169.         ElseIf Trim(str_State) = "2" Then
  170.             Call Card_Edit(Trim(Num_text.Text))
  171.             SzToolbar.Buttons("xg").Enabled = False
  172.             SzToolbar.Buttons("sc").Enabled = False
  173.             SzToolbar.Buttons("bc").Enabled = True
  174.             SzToolbar.Buttons("fq").Enabled = True
  175.             SzToolbar.Buttons("first").Enabled = False
  176.             SzToolbar.Buttons("prev").Enabled = False
  177.             SzToolbar.Buttons("next").Enabled = False
  178.             SzToolbar.Buttons("last").Enabled = False
  179.             Call Open_Lock
  180.             Call Txt_Lock
  181.         ElseIf Trim(str_State) = "4" Then
  182.             Call Card_Edit(Trim(Num_text.Text))
  183.             SzToolbar.Buttons("zj").Enabled = False
  184.             SzToolbar.Buttons("xg").Enabled = False
  185.             SzToolbar.Buttons("sc").Enabled = False
  186.             SzToolbar.Buttons("bc").Enabled = False
  187.             SzToolbar.Buttons("fq").Enabled = False
  188.             SzToolbar.Buttons("first").Enabled = True
  189.             SzToolbar.Buttons("prev").Enabled = True
  190.             SzToolbar.Buttons("next").Enabled = True
  191.             SzToolbar.Buttons("last").Enabled = True
  192.             Call Txt_Lock
  193.         Else
  194.             Call Card_Edit(Trim(Num_text.Text))
  195.             SzToolbar.Buttons("xg").Enabled = True
  196.             SzToolbar.Buttons("sc").Enabled = True
  197.             SzToolbar.Buttons("bc").Enabled = False
  198.             SzToolbar.Buttons("fq").Enabled = False
  199.             SzToolbar.Buttons("first").Enabled = True
  200.             SzToolbar.Buttons("prev").Enabled = True
  201.             SzToolbar.Buttons("next").Enabled = True
  202.             SzToolbar.Buttons("last").Enabled = True
  203.             Call Txt_Lock
  204.             Set rstemp = New ADODB.Recordset
  205.             rstemp.Open "select * from Gdzc_Card where CardCode='" & Trim(Lbl_Num.Caption) & "'", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
  206.             If Not rstemp.EOF Then
  207.                 If rstemp!Year = Xtyear And rstemp!Period = Xtmm Then
  208.                     SzToolbar.Buttons("xg").Enabled = True
  209.                     SzToolbar.Buttons("sc").Enabled = True
  210.                 Else
  211.                     SzToolbar.Buttons("xg").Enabled = True
  212.                     SzToolbar.Buttons("sc").Enabled = False
  213.                 End If
  214.             End If
  215.             rstemp.Close
  216.             Set rstemp = Nothing
  217.             
  218.             Set rstemp = Cw_DataEnvi.DataConnect.Execute("select top 1 * from gy_kjrlb where gdzcjzbz='0'")
  219.             If Not rstemp.EOF Then
  220.                 If Val(rstemp!KjYear) <> Val(Xtyear) Or Val(rstemp!Period) <> Val(Xtmm) Then
  221.                     SzToolbar.Buttons("zj").Enabled = False
  222.                 Else
  223.                     SzToolbar.Buttons("zj").Enabled = True
  224.                 End If
  225.             End If
  226.             rstemp.Close
  227.             Set rstemp = Nothing
  228.             
  229.             Set rstemp = Cw_DataEnvi.DataConnect.Execute("select * from Gdzc_Card")
  230.             If rstemp.EOF Then
  231.                 SzToolbar.Buttons("xg").Enabled = False
  232.                 SzToolbar.Buttons("sc").Enabled = False
  233.             End If
  234.             rstemp.Close
  235.             Set rstemp = Nothing
  237.             Me.AutoRedraw = True
  238.         End If
  239.     End If
  240.     
  241. End Sub
  243. '卡片存盘
  244. Function Lrbc()                                   '保存
  245.     
  246.     Dim Depr_Str As String                        '折旧方法编号变量
  247.     Dim NumTemp As Integer                        '文本框Index变量
  248.     Dim str As String
  249.     Dim rs As ADODB.Recordset
  250.     
  251.     '取得折旧方法编号
  252.     Select Case Trim(Com_DeprMethod.Text)           '折旧方法
  253.         Case "不计提折旧"
  254.             Depr_Str = "01"
  255.         Case "平均年限法(依净资产计提折旧)"
  256.             Depr_Str = "02"
  257.         Case "平均年限法(依帐面原值计提折旧)"
  258.             Depr_Str = "03"
  259.         Case "工作量法"
  260.             Depr_Str = "04"
  261.         Case "固定折旧额折旧法"
  262.             Depr_Str = "05"
  263.         Case "年数总和法"
  264.             Depr_Str = "06"
  265.         Case "双倍余额法"
  266.             Depr_Str = "07"
  267.     End Select
  268.     
  269.     For NumTemp = 33 To 52                                   '自定义项
  270.         If LrText(NumTemp).Visible = True Then
  271.             LrText(NumTemp).Tag = Trim("zdy" & Val(NumTemp - 32))
  272.         End If
  273.     Next NumTemp
  274.    
  275.     If Trim(str_State) = "1" Then                      '新增
  277.         On Error GoTo Cwcl
  278.         Cw_DataEnvi.DataConnect.BeginTrans
  280.         '增加资产卡片(Gdzc_Card)表
  281.         Set rstemp = New ADODB.Recordset
  282.         With rstemp
  283.             .Open "select * from gdzc_card where 1=2", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
  284.             .AddNew
  285.             .Fields("CardCode") = Trim(Lbl_Num.Caption)              '卡片编号
  286.             .Fields("FACode") = Trim(LrText(13).Text)                '资产编号
  287.             .Fields("FAName") = Trim(LrText(2).Text)                 '固定资产名称
  288.             .Fields("FASortCode") = Trim(LrText(3).Tag)              '资产类别编号
  289.             .Fields("SpecificationMode") = Trim(LrText(16).Text)     '规格型号
  290.             .Fields("FAQuantity") = Val(LrText(14).Text)             '资产数量
  291.             .Fields("MeasureUnit") = Trim(LrText(4).Text)            '计量单位
  292.             .Fields("Year") = Val(Lbl_Year.Caption)                  '会计年度
  293.             .Fields("Period") = Val(Lbl_Period.Caption)              '会计期间
  294.             .Fields("DeptCode") = Trim(LrText(5).Tag)                '部门编号
  295.             If Trim(Com_Type.Text) = "新增固定资产" Then             '卡片类型(0-新增，1－原始)
  296.                 .Fields("CardType") = True
  297.                 .Fields("whetherNew") = True
  298.             Else
  299.                 .Fields("CardType") = False
  300.                 .Fields("whetherNew") = False
  301.             End If
  302.             .Fields("Opreator") = Trim(Lbl_Operator.Caption)         '操作员
  303.             .Fields("FAVariCode") = Trim(LrText(6).Tag)              '资产增加方式
  304.             .Fields("SetLocaNum") = Trim(LrText(18).Text)            '设备位号
  305.             .Fields("FAStateCode") = Trim(LrText(7).Tag)             '使用状况
  306.             .Fields("UseYears") = Val(LrText(15).Text)               '使用年限
  307.             .Fields("DeprMothes") = Val(LrText(25).Text)             '折旧月数
  308.             .Fields("Activities") = Val(LrText(30).Text)             '工作总量
  309.             .Fields("DeprMethod") = Depr_Str                         '折旧方法
  310.             .Fields("AcitvitiesSum") = Val(LrText(32).Text)          '累计工作量
  311.             If Trim(LrText(0).Text) <> "" Then .Fields("BeginUseDate") = Trim(LrText(0).Text)         '开始使用日期
  312.             .Fields("ForeignCurrCode") = Trim(LrText(12).Tag)        '货币编码
  313.             .Fields("ForeignValue") = CCur(Format(Val(LrText(21).Text), "##0.00"))         '外币金额
  314.             .Fields("AccRate") = Val(LrText(20).Text)                '记帐汇率
  315.             .Fields("FAValue") = CCur(Format(Val(LrText(22).Text), "##0.00"))              '资产原值
  316.             .Fields("DeprSum") = CCur(Format(Val(LrText(23).Text), "##0.00"))               '累计折旧
  317.             .Fields("FactValue") = CCur(Format(Val(Val(LrText(22).Text) - Val(LrText(23).Text)), "##0.00"))    '净资产
  318.             .Fields("DeprRate") = Val(LrText(27).Text)               '月折旧率
  319.             .Fields("DeprValue") = CCur(Format(Val(LrText(26).Text), "##0.00"))            '月折旧额
  320.             .Fields("SalRate") = Val(LrText(28).Text)                '净残值率
  321.             .Fields("SalValue") = CCur(Format(Val(LrText(29).Text), "##0.00"))              '净残值
  322.             .Fields("Product") = Trim(LrText(17).Text)               '生产商
  323.             .Fields("VouchClassCode") = Trim(LrText(11).Tag)         '凭证类别
  324.             If Trim(LrText(19).Text) <> "" Then .Fields("VouchNo") = Trim(LrText(19).Text)            '凭证号
  325.             If Trim(LrText(1).Text) <> "" Then .Fields("WriteDate") = CDate(LrText(1).Text)            '录入日期
  326.             .Fields("FACcode") = Trim(LrText(8).Tag)                 '固定资产折旧科目
  327.             .Fields("DeprCcode") = Trim(LrText(9).Tag)               '累计资产折旧科目
  328.             .Fields("DeprMoneyCcode") = Trim(LrText(10).Tag)         '折旧费用科目编码
  329.             For NumTemp = 33 To 52                                   '自定义项
  330.                 If LrText(NumTemp).Text <> "" And LrText(NumTemp).Visible = True Then
  331.                     .Fields(Trim(LrText(NumTemp).Tag)) = Trim(LrText(NumTemp).Text)
  332.                     Set rs = New ADODB.Recordset
  333.                     rs.Open "select * from gdzc_custom where fieldcode='" & Trim(LrText(NumTemp).Tag) & "'", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
  334.                     If Not rs.EOF Then
  335.                         If rs.Fields("WhetherNull") = False Then rs.Fields("WhetherNull") = True
  336.                         rs.Update
  337.                     End If
  338.                     rs.Close
  339.                     Set rs = Nothing
  340.                 End If
  341.             Next NumTemp
  342.             .Update
  343.         End With
  344.         rstemp.Close
  345.         Set rstemp = Nothing
  346.         
  347.         '当用户选择的资产折旧方法是“工作量法”时，追加工作量表
  348.         If Trim(Com_DeprMethod.Text) = "工作量法" Then
  349.             Set rstemp = New ADODB.Recordset
  350.             With rstemp
  351.                 .Open "select * from Gdzc_jobquantity where 1=2", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
  352.                 .AddNew
  353.                 .Fields("CardCode") = Trim(Lbl_Num.Caption)          '卡片编号
  354.                 .Fields("Year") = Val(Lbl_Year.Caption)              '会计年度
  355.                 .Fields("Period") = Val(Lbl_Period.Caption)          '会计期间
  356.                 .Fields("ActivitiesStart") = Val(LrText(30).Text)    '工作总量
  357.                 .Fields("AcivitiesAEnd") = Val(LrText(30).Text)      '累计工作量
  358.                 .Fields("AcivitiesUnit") = Trim(LrText(31).Text)     '工作量单位
  359.                 .Update
  360.             End With
  361.             rstemp.Close
  362.             Set rstemp = Nothing
  363.         End If
  364.         
  365.         '追加会计明细表记录
  366.         Set rstemp = New ADODB.Recordset
  367.         With rstemp
  368.             .Open "select * from Gdzc_DetailedForm where 1=2", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
  369.             .AddNew
  370.             .Fields("cardcode") = Trim(Lbl_Num.Caption)        '卡片编号
  371.             .Fields("FASortCode") = Trim(LrText(3).Tag)        '资产类别编号
  372.             .Fields("Year") = Trim(Lbl_Year.Caption)           '会计年度
  373.             .Fields("Period") = Trim(Lbl_Period.Caption)       '会计期间
  374.             .Fields("MmMake") = True                           '录入期间标志
  375.             .Fields("FAValueEnd") = CCur(Format(Val(LrText(22).Text), "##0.00"))      '资产原值
  376.             .Fields("DeprsumEnd") = CCur(Format(Val(LrText(23).Text), "##0.00"))       '期末累计折旧
  377.             .Update
  378.         End With
  379.         rstemp.Close
  380.         Set rstemp = Nothing
  381.         
  382.         '追加或修改资产汇总表记录
  383.         Set rstemp = New ADODB.Recordset
  384.         str = "select * from Gdzc_Total where DeptCode='" & Trim(LrText(5).Tag) & "' and FASortCode='" & Trim(LrText(3).Tag) & "' and Year=" & Val(Lbl_Year.Caption) & " and Period=" & Trim(Lbl_Period.Caption)
  385.         rstemp.Open str, Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
  386.         With rstemp
  387.             If .EOF Then
  388.                 .AddNew
  389.                 .Fields("Deptcode") = Trim(LrText(5).Tag)           '部门编号
  390.                 .Fields("FASortCode") = Trim(LrText(3).Tag)        '资产类别编号
  391.                 .Fields("Year") = Val(Lbl_Year.Caption)             '会计年度
  392.                 .Fields("Period") = Val(Lbl_Period.Caption)         '会计期间
  393.                 .Fields("FAValueEndM") = CCur(Format(Val(LrText(22).Text), "##0.00"))      '月末原值
  394.                 .Fields("DeprSumEndM") = CCur(Format(Val(LrText(23).Text), "##0.00"))      '月末累计折旧
  395.                 .Fields("FAValueInM") = CCur(Format(Val(LrText(22).Text), "##0.00"))       '本期增加原值
  396.                 .Fields("DeprSumInM") = CCur(Format(Val(LrText(23).Text), "##0.00"))       '本期累计折旧增加
  397.             Else
  398.                 .Fields("FAValueEndM") = CCur(Format(Val(.Fields("FAValueEndM")) + Val(LrText(22).Text), "##0.00"))  '月末原值
  399.                 .Fields("DeprSumEndM") = CCur(Val(.Fields("DeprSumEndM")) + Val(LrText(23).Text))   '月末累计折旧
  400.                 .Fields("FAValueInM") = CCur(Val(.Fields("FAValueInM")) + Val(LrText(22).Text))     '本期增加原值
  401.                 .Fields("DeprSumInM") = CCur(Val(.Fields("DeprSumInM")) + Val(LrText(23).Text))     '本期累计折旧增减
  402.             End If
  403.             .Update
  404.         End With
  405.         rstemp.Close
  406.         Set rstemp = Nothing
  407.         
  408.         '追加资产变动单据表
  409.         Call Vari
  410.         Set rstemp = New ADODB.Recordset
  411.         With rstemp
  412.             .Open "Select * from Gdzc_Variation where 1=2", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
  413.             .AddNew
  414.             .Fields("VariVouCode") = MaxCode                 '变动单号
  415.             .Fields("CardCode") = Trim(Lbl_Num.Caption)      '卡片编号
  416.             .Fields("Year") = Trim(Lbl_Year.Caption)         '会计年度
  417.             .Fields("Period") = Trim(Lbl_Period.Caption)     '会计期间
  418.             .Fields("FAVariCode") = Trim(LrText(6).Tag)      '资产变动
  419.             .Fields("VouchClassCode") = Trim(LrText(11).Tag) '凭证类别
  420.             .Fields("VouchNo") = Val(LrText(19).Text)        '凭证号
  421.             .Fields("VariationReason") = Trim(Com_Type.Text) '资产变动原因
  422.             .Fields("DeptNew") = Trim(LrText(5).Tag)         '所属部门
  423.             .Fields("FAStateNew") = Trim(LrText(7).Tag)      '使用状况
  424.             .Fields("DeprMethNew") = Depr_Str                '折旧方法
  425.             .Fields("FASortNew") = Trim(LrText(3).Tag)       '资产类别编号
  426.             .Fields("FAValueNew") = CCur(Val(LrText(22).Text))    '资产原值
  427.             .Fields("SumDeprNew") = CCur(Val(LrText(23).Text))    '资产累计折旧
  428.             .Fields("ActivitiesNew") = Val(LrText(30).Text)  '工作总量
  429.             .Fields("SalValueNew") = CCur(Val(LrText(29).Text))   '净残值
  430.             .Fields("UseYearsNew") = Val(LrText(15).Text)    '使用年限
  431.             .Fields("FAQuantityNew") = Val(LrText(14).Text)  '资产数量
  432.             .Fields("Opreator") = Trim(Lbl_Operator.Caption) '操作员
  433.             .Fields("VariDate") = Xtrq
  434.             .Update
  435.         End With
  436.         rstemp.Close
  437.         Set rstemp = Nothing
  438.         
  439.         Cw_DataEnvi.DataConnect.CommitTrans
  440.         MsgBox "保存完毕!          ", vbOKOnly + vbInformation, "百利/ERP5.0-固定资产"
  441.         
  442.         Kpgl_CardList.Tj_YesNo = True
  443.         Call Zdbm
  444.         Call Txt_Clear
  445.         TextChangeLock = True
  446.         LrText(13).SetFocus
  447.         Exit Function
  448.     
  449.     ElseIf Trim(str_State) = "2" Then '修改
  450.         
  451.         Dim FAValue_Temp As Double              '修改原资产原值变量
  452.         Dim DeprSum_temp As Double              '修改原累计折旧变量
  453.         Dim Dept_Temp As String                 '部门编号
  454.         Dim Sort As String                      '资产类别
  455.         
  456.         On Error GoTo Cwcl
  457.         Cw_DataEnvi.DataConnect.BeginTrans
  459.         '修改资产卡片(Gdzc_Card)表
  460.         Set rstemp = New ADODB.Recordset
  461.         With rstemp
  462.             .Open "select * from gdzc_card where CardCode='" & Trim(Lbl_Num.Caption) & "'", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
  463.             If Not .EOF Then
  464.                 FAValue_Temp = .Fields("FAValue")                                 '借助变量存储修改资产原值
  465.                 DeprSum_temp = .Fields("DeprSum")                                 '借助变量存储修改累计折旧
  466.                 Dept_Temp = .Fields("DeptCode")
  467.                 Sort = .Fields("FASortCode")
  468.                 .Fields("CardCode") = Trim(Lbl_Num.Caption)              '卡片编号
  469.                 .Fields("FACode") = Trim(LrText(13).Text)                '资产编号
  470.                 .Fields("FAName") = Trim(LrText(2).Text)                 '固定资产名称
  471.                 .Fields("FASortCode") = Trim(LrText(3).Tag)              '资产类别编号
  472.                 .Fields("SpecificationMode") = Trim(LrText(16).Text)     '规格型号
  473.                 .Fields("FAQuantity") = Val(LrText(14).Text)             '资产数量
  474.                 .Fields("MeasureUnit") = Trim(LrText(4).Text)            '计量单位
  475.                 .Fields("Year") = Val(Lbl_Year.Caption)                  '会计年度
  476.                 .Fields("Period") = Val(Lbl_Period.Caption)              '会计期间
  477.                 .Fields("DeptCode") = Trim(LrText(5).Tag)                '部门编号
  478.                 If Trim(Com_Type.Text) = "新增固定资产" Then             '卡片类型(0-新增，1－原始)
  479.                     .Fields("CardType") = True
  480.                     .Fields("whetherNew") = True
  481.                 Else
  482.                     .Fields("CardType") = False
  483.                     .Fields("whetherNew") = False
  484.                 End If
  485.                 .Fields("Opreator") = Trim(Lbl_Operator.Caption)         '操作员
  486.                 .Fields("FAVariCode") = Trim(LrText(6).Tag)              '资产增加方式
  487.                 .Fields("SetLocaNum") = Trim(LrText(18).Text)            '设备位号
  488.                 .Fields("FAStateCode") = Trim(LrText(7).Tag)             '使用状况
  489.                 .Fields("UseYears") = Val(LrText(15).Text)               '使用年限
  490.                 .Fields("DeprMothes") = Val(LrText(25).Text)             '折旧月数
  491.                 .Fields("Activities") = Val(LrText(30).Text)             '工作总量
  492.                 .Fields("DeprMethod") = Depr_Str                         '折旧方法
  493.                 .Fields("AcitvitiesSum") = Val(LrText(32).Text)          '累计工作量
  494.                 If Trim(LrText(0).Text) <> "" Then .Fields("BeginUseDate") = Trim(LrText(0).Text)         '开始使用日期
  495.                 .Fields("ForeignCurrCode") = Trim(LrText(12).Tag)        '货币编码
  496.                 .Fields("ForeignValue") = CCur(Format(Val(LrText(21).Text), "##0.00"))         '外币金额
  497.                 .Fields("AccRate") = Val(LrText(20).Text)                '记帐汇率
  498.                 .Fields("FAValue") = CCur(Format(Val(LrText(22).Text), "##0.00"))              '资产原值
  499.                 .Fields("DeprSum") = CCur(Format(Val(LrText(23).Text), "##0.00"))               '累计折旧
  500.                 .Fields("FactValue") = CCur(Format(Val(Val(LrText(22).Text) - Val(LrText(23).Text)), "##0.00"))     '净资产
  501.                 .Fields("DeprRate") = Val(LrText(27).Text)               '月折旧率
  502.                 .Fields("DeprValue") = CCur(Format(Val(LrText(26).Text), "##0.00"))            '月折旧额
  503.                 .Fields("SalRate") = Val(LrText(28).Text)                '净残值率
  504.                 .Fields("SalValue") = CCur(Format(Val(LrText(29).Text), "##0.00"))              '净残值
  505.                 .Fields("Product") = Trim(LrText(17).Text)               '生产商
  506.                 .Fields("VouchClassCode") = Trim(LrText(11).Tag)         '凭证类别
  507.                 .Fields("VouchNo") = Val(LrText(19).Text)               '凭证号
  508.                 .Fields("WriteDate") = Trim(LrText(1).Text)              '录入日期
  509.                 .Fields("FACcode") = Trim(LrText(8).Tag)                 '固定资产折旧科目
  510.                 .Fields("DeprCcode") = Trim(LrText(9).Tag)               '累计资产折旧科目
  511.                 .Fields("DeprMoneyCcode") = Trim(LrText(10).Tag)         '折旧费用科目编码
  512.                 For NumTemp = 33 To 52                                   '自定义项
  513.                     If LrText(NumTemp).Visible = True Then
  514.                         Set rs = New ADODB.Recordset
  515.                         rs.Open "select * from gdzc_custom where FieldCode='" & Trim(LrText(NumTemp).Tag) & "' and FieldState='1'", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
  516.                         If Not rs.EOF Then
  517.                             If rs!datatype = 2 Or rs!datatype = 3 Then
  518.                                 .Fields(Trim(LrText(NumTemp).Tag)) = Val(LrText(NumTemp).Text)
  519.                             ElseIf rs!datatype = 4 Then
  520.                                 .Fields(Trim(LrText(NumTemp).Tag)) = CCur(Val(Trim(LrText(NumTemp).Text)))
  521.                             ElseIf rs!datatype = 5 Then
  522.                                 If Trim(LrText(NumTemp).Text) = "" Then
  523.                                     .Fields(Trim(LrText(NumTemp).Tag)) = Null
  524.                                 Else
  525.                                     .Fields(Trim(LrText(NumTemp).Tag)) = Trim(LrText(NumTemp).Text & "")
  526.                                 End If
  527.                             Else
  528.                                 .Fields(Trim(LrText(NumTemp).Tag)) = Trim(LrText(NumTemp).Text & "")
  529.                             End If
  530.                         End If
  531.                         rs.Close
  532.                         Set rs = Nothing
  533.                         Set rs = New ADODB.Recordset
  534.                         rs.Open "select * from gdzc_custom where fieldcode='" & Trim(LrText(NumTemp).Tag) & "'", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
  535.                         If Not rs.EOF Then
  536.                             If rs.Fields("WhetherNull") = False Then rs.Fields("WhetherNull") = True
  537.                             rs.Update
  538.                         End If
  539.                         rs.Close
  540.                         Set rs = Nothing
  541.                     End If
  542.                 Next NumTemp
  543.                 .Update
  544.             End If
  545.         End With
  546.         rstemp.Close
  547.         Set rstemp = Nothing
  548.         
  549.         '当用户选择的资产折旧方法是“工作量法”时，修改工作量表
  550.         If Trim(Com_DeprMethod.Text) = "工作量法" Then
  551.             Set rstemp = New ADODB.Recordset
  552.             With rstemp
  553.                 .Open "select * from Gdzc_jobquantity where CardCode='" & Trim(Lbl_Num.Caption) & "'", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
  554.                 If Not .EOF Then
  555.                     .Fields("CardCode") = Trim(Lbl_Num.Caption)          '卡片编号
  556.                     .Fields("Year") = Val(Lbl_Year.Caption)              '会计年度
  557.                     .Fields("Period") = Val(Lbl_Period.Caption)          '会计期间
  558.                     .Fields("ActivitiesStart") = Val(LrText(30).Text)    '工作总量
  559.                     .Fields("AcivitiesAEnd") = Val(LrText(30).Text)      '累计工作量
  560.                     .Fields("AcivitiesUnit") = Trim(LrText(31).Text)     '工作量单位
  561.                     .Update
  562.                 End If
  563.             End With
  564.             rstemp.Close
  565.             Set rstemp = Nothing
  566.         End If
  567.         
  568.         '修改会计明细表记录
  569.         Set rstemp = New ADODB.Recordset
  570.         With rstemp
  571.             .Open "select * from Gdzc_DetailedForm where CardCode='" & Trim(Lbl_Num.Caption) & "' and year=" & Val(Lbl_Year.Caption) & " and period=" & Val(Lbl_Period.Caption), Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
  572.             .Fields("cardcode") = Trim(Lbl_Num.Caption)        '卡片编号
  573.             .Fields("FASortCode") = Trim(LrText(3).Tag)        '资产类别编号
  574.             .Fields("Year") = Trim(Lbl_Year.Caption)           '会计年度
  575.             .Fields("Period") = Trim(Lbl_Period.Caption)       '会计期间
  576.             .Fields("MmMake") = True                           '录入期间标志
  577.             .Fields("FAValueEnd") = CCur(Format(Val(LrText(22).Text), "##0.00"))      '资产原值
  578.             .Fields("DeprSumEnd") = CCur(Format(Val(LrText(23).Text), "##0.00"))       '期末累计折旧
  579.             .Update
  580.         End With
  581.         rstemp.Close
  582.         Set rstemp = Nothing
  583.         
  584.         '修改资产汇总表记录
  585.         Set rstemp = New ADODB.Recordset
  586.         str = "select * from Gdzc_Total where DeptCode='" & Trim(Dept_Temp) & "' and FASortCode='" & Trim(Sort) & "' and Year=" & Val(Lbl_Year.Caption) & " and Period=" & Trim(Lbl_Period.Caption)
  587.         rstemp.Open str, Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
  588.         With rstemp
  589.             If Not .EOF Then
  590.                 If Val(.Fields("FAValueEndM")) - Val(FAValue_Temp) = 0 Then
  591.                     .Delete
  592.                     .Update
  593.                 Else
  594.                     .Fields("FAValueEndM") = CCur(Format(Val(.Fields("FAValueEndM")) - FAValue_Temp + Val(LrText(22).Text), "##0.00")) '月末原值
  595.                     .Fields("DeprSumEndM") = CCur(Val(.Fields("DeprSumEndM")) - DeprSum_temp + Val(LrText(23).Text)) '月末累计折旧
  596.                     .Fields("FAValueInM") = CCur(Val(.Fields("FAValueInM")) - FAValue_Temp + Val(LrText(22).Text))     '本期增加原值
  597.                     .Fields("DeprSumInM") = CCur(Val(.Fields("DeprSumInM")) - DeprSum_temp + Val(LrText(23).Text))      '本期累计折旧增加
  598.                     .Update
  599.                 End If
  600.             End If
  601.         End With
  602.         rstemp.Close
  603.         Set rstemp = Nothing
  604.         
  605.         '追加或修改资产汇总表记录
  606.         Set rstemp = New ADODB.Recordset
  607.         str = "select * from Gdzc_Total where DeptCode='" & Trim(LrText(5).Tag) & "' and FASortCode='" & Trim(LrText(3).Tag) & "' and Year=" & Val(Lbl_Year.Caption) & " and Period=" & Trim(Lbl_Period.Caption)
  608.         rstemp.Open str, Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
  609.         With rstemp
  610.             If .EOF Then
  611.                 .AddNew
  612.                 .Fields("Deptcode") = Trim(LrText(5).Tag)           '部门编号
  613.                 .Fields("FASortCode") = Trim(LrText(3).Tag)        '资产类别编号
  614.                 .Fields("Year") = Val(Lbl_Year.Caption)             '会计年度
  615.                 .Fields("Period") = Val(Lbl_Period.Caption)         '会计期间
  616.                 .Fields("FAValueEndM") = CCur(Format(Val(LrText(22).Text), "##0.00"))      '月末原值
  617.                 .Fields("DeprSumEndM") = CCur(Format(Val(LrText(23).Text), "##0.00"))      '月末累计折旧
  618.                 .Fields("FAValueInM") = CCur(Format(Val(LrText(22).Text), "##0.00"))       '本期增加原值
  619.                 .Fields("DeprSumInM") = CCur(Format(Val(LrText(23).Text), "##0.00"))       '本期累计折旧增加
  620.             Else
  621.                 .Fields("FAValueEndM") = CCur(Format(Val(.Fields("FAValueEndM")) + Val(LrText(22).Text), "##0.00"))  '月末原值
  622.                 .Fields("DeprSumEndM") = CCur(Val(.Fields("DeprSumEndM")) + Val(LrText(23).Text))   '月末累计折旧
  623.                 .Fields("FAValueInM") = CCur(Val(.Fields("FAValueInM")) + Val(LrText(22).Text))     '本期增加原值
  624.                 .Fields("DeprSumInM") = CCur(Val(.Fields("DeprSumInM")) + Val(LrText(23).Text))     '本期累计折旧增减
  625.             End If
  626.             .Update
  627.         End With
  628.         rstemp.Close
  629.         Set rstemp = Nothing
  630.        
  631.         '修改资产变动单据表
  632.         Call Vari
  633.         Set rstemp = New ADODB.Recordset
  634.         With rstemp
  635.             .Open "Select * from Gdzc_Variation where CardCode='" & Trim(Lbl_Num.Caption) & "' and year=" & Val(Lbl_Year.Caption) & " and Period=" & Val(Lbl_Period.Caption), Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
  636.             If Not .EOF Then
  637.                 .Fields("CardCode") = Trim(Lbl_Num.Caption)      '卡片编号
  638.                 .Fields("Year") = Trim(Lbl_Year.Caption)         '会计年度
  639.                 .Fields("Period") = Trim(Lbl_Period.Caption)     '会计期间
  640.                 .Fields("FAVariCode") = Trim(LrText(6).Tag)      '资产变动
  641.                 .Fields("VouchClassCode") = Trim(LrText(11).Tag) '凭证类别
  642.                 If Trim(LrText(19).Text) <> "" Then .Fields("VouchNo") = Trim(LrText(19).Text)     '凭证号
  643.                 .Fields("VariationReason") = Trim(Com_Type.Text) '资产变动原因
  644.                 .Fields("DeptNew") = Trim(LrText(5).Tag)         '所属部门
  645.                 .Fields("FAStateNew") = Trim(LrText(7).Tag)      '使用状况
  646.                 .Fields("DeprMethNew") = Depr_Str                '折旧方法
  647.                 .Fields("FASortNew") = Trim(LrText(3).Tag)       '资产类别编号
  648.                 .Fields("FAValueNew") = CCur(Val(LrText(22).Text))    '资产原值
  649.                 .Fields("SumDeprNew") = CCur(Val(LrText(23).Text))    '资产累计折旧
  650.                 .Fields("ActivitiesNew") = Val(LrText(30).Text)  '工作总量
  651.                 .Fields("SalValueNew") = CCur(Val(LrText(29).Text))   '净残值
  652.                 .Fields("UseYearsNew") = Val(LrText(15).Text)    '使用年限
  653.                 .Fields("FAQuantityNew") = Val(LrText(14).Text)  '资产数量
  654.                 .Fields("Opreator") = Trim(Lbl_Operator.Caption) '操作员
  655.                 .Fields("VariDate") = Xtrq
  656.                 .Update
  657.             Else
  658.                 .AddNew
  659.                 .Fields("VariVouCode") = MaxCode                 '变动单号
  660.                 .Fields("CardCode") = Trim(Lbl_Num.Caption)      '卡片编号
  661.                 .Fields("Year") = Trim(Lbl_Year.Caption)         '会计年度
  662.                 .Fields("Period") = Trim(Lbl_Period.Caption)     '会计期间
  663.                 .Fields("FAVariCode") = Trim(LrText(6).Tag)      '资产变动
  664.                 .Fields("VouchClassCode") = Trim(LrText(11).Tag) '凭证类别
  665.                 If Trim(LrText(19).Text) <> "" Then .Fields("VouchNo") = Trim(LrText(19).Text)     '凭证号
  666.                 .Fields("VariationReason") = Trim(Com_Type.Text) '资产变动原因
  667.                 .Fields("DeptNew") = Trim(LrText(5).Tag)         '所属部门
  668.                 .Fields("FAStateNew") = Trim(LrText(7).Tag)      '使用状况
  669.                 .Fields("DeprMethNew") = Depr_Str                '折旧方法
  670.                 .Fields("FASortNew") = Trim(LrText(3).Tag)       '资产类别编号
  671.                 .Fields("FAValueNew") = CCur(Val(LrText(22).Text))    '资产原值
  672.                 .Fields("SumDeprNew") = CCur(Val(LrText(23).Text))    '资产累计折旧
  673.                 .Fields("ActivitiesNew") = Val(LrText(30).Text)  '工作总量
  674.                 .Fields("SalValueNew") = CCur(Val(LrText(29).Text))   '净残值
  675.                 .Fields("UseYearsNew") = Val(LrText(15).Text)    '使用年限
  676.                 .Fields("FAQuantityNew") = Val(LrText(14).Text)  '资产数量
  677.                 .Fields("Opreator") = Trim(Lbl_Operator.Caption) '操作员
  678.                 .Fields("VariDate") = Xtrq
  679.                 .Update
  680.             End If
  681.         End With
  682.         rstemp.Close
  683.         Set rstemp = Nothing
  684.         
  685.         Cw_DataEnvi.DataConnect.CommitTrans
  686.         MsgBox "保存完毕!          ", vbOKOnly + vbInformation, "百利/ERP5.0-固定资产"
  687.         Kpgl_CardList.Tj_YesNo = True
  688.         str_State = "3"
  689.         Me.AutoRedraw = False
  690.         SetToolState
  691.         Exit Function
  692.     Else
  693.         Exit Function
  694.     End If
  695. Cwcl:
  696.     Cw_DataEnvi.DataConnect.RollbackTrans
  697.     Tsxx = "您的输入有误导致存盘失败，请核对数据！"
  698.     Call Xtxxts(Tsxx, 0, 1)
  699.     Exit Function
  700.     
  701. End Function
  703. '卡片自动编号
  704. Function Zdbm()                                         '卡片自动编号
  705.     
  706.     Dim Max_Code As Double                              '最大值数值变量
  707.     
  708.     Set rstemp = New ADODB.Recordset
  709.     rstemp.Open "select max(CardCode) as Max_CardCode from Gdzc_card", Cw_DataEnvi.DataConnect, adOpenKeyset, adLockOptimistic
  710.     If Val(rstemp.Fields("Max_CardCode") & "") = 0 Then
  711.         Max_Code = 1
  712.     Else
  713.         Max_Code = Val(rstemp.Fields("Max_CardCode")) + 1
  714.     End If
  715.     rstemp.Close
  716.     Set rstemp = Nothing
  717.     
  718.     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)))))
  719.     Lbl_Num.Caption = MaxCode
  721. End Function
  723. '变动单自动编号
  724. Function Vari()
  725.     
  726.     Dim Max_Code As Double                              '最大值数值变量
  727.     
  728.     Set rstemp = New ADODB.Recordset
  729.     rstemp.Open "select max(VariVouCode) as Max_CardCode from Gdzc_Variation", Cw_DataEnvi.DataConnect, adOpenKeyset, adLockOptimistic
  730.     If Val(rstemp.Fields("Max_CardCode") & "") = 0 Then
  731.         Max_Code = 1
  732.     Else
  733.         Max_Code = Val(rstemp.Fields("Max_CardCode")) + 1
  734.     End If
  735.     rstemp.Close
  736.     Set rstemp = Nothing
  737.     
  738.     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)))))
  740. End Function
  742. '根据折旧方法的选择，决定工作总量、工作量单位和累计工作量文本框的Enable状态
  743. Private Sub Com_DeprMethod_Click()
  744.     
  745.     If str_State = "1" Or str_State = "2" Then
  746.         If Trim(Com_DeprMethod.Text) = "工作量法" Or Trim(Com_DeprMethod.Text) = "不计提折旧" Then
  747.             LrText(30).Enabled = True
  748.             LrText(31).Enabled = True
  749.             LrText(32).Enabled = True
  750.             LrText(26).Enabled = False
  751.             LrText(27).Enabled = False
  752.         Else
  753.             LrText(26).Enabled = True
  754.             LrText(27).Enabled = True
  755.             LrText(30).Enabled = False
  756.             LrText(31).Enabled = False
  757.             LrText(32).Enabled = False
  758.         End If
  759.     End If
  760.     
  761. End Sub
  763. '显示自定义项
  764. Function Define()
  765.     
  766.     Dim i As Integer
  767.     
  768.     Set rstemp = New ADODB.Recordset
  769.     rstemp.Open "select * from Gdzc_custom where FieldState='1'", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
  770.     i = 33
  771.     While Not rstemp.EOF
  772.         Lblzdy(i).Visible = True
  773.         LrText(i).Visible = True
  774.         Lblzdy(i).Caption = rstemp.Fields("FieldName") & ":"
  775.         LrText(i).Tag = rstemp.Fields("FieldCode")
  776.         Lblzdy(i).Left = LrText(i).Left - 25 - Lblzdy(i).Width
  777.         rstemp.MoveNext
  778.         i = i + 1
  779.     Wend
  780.     rstemp.Close
  781.     Set rstemp = Nothing
  782.     
  783. End Function
  785. '固定资产折旧算法
  786. Function DeprMethod()
  787.     
  788.     If Val(Lbl_FactValue.Caption) = 0 Or Val(LrText(15).Text) = 0 Then Exit Function
  789.     
  790.     Select Case Trim(Com_DeprMethod.Text)           '折旧方法
  791.         Case "平均年限法(依净资产计提折旧)"
  792.             '月折旧额＝净资产÷剩余使用年限÷12
  793.             '月折旧率＝月折旧额÷净资产
  794.             LrText(26).Text = Format(Val(Lbl_FactValue.Caption) / (Val(LrText(15).Text) - (Val(LrText(25).Text) / 12)), "##0.00") / 12 '月折旧额
  795.             LrText(27).Text = Format(Val(LrText(26).Text) / Val(Lbl_FactValue.Caption), "##0.000000")      '月折旧率
  796.         Case "平均年限法(依帐面原值计提折旧)"
  797.             '月折旧额＝（资产记帐原值－预计净残值）÷预计使用年限÷12
  798.             '月折旧率＝记帐原值×（1－残值率）×12÷使用年限
  799.             LrText(26).Text = Format(Val(LrText(22).Text) * (1 - Val(LrText(28).Text)) / Val(LrText(15).Text) / 12, "##0.00") '月折旧额
  800.             LrText(27).Text = Format(Val(LrText(26).Text) * (1 - Val(LrText(28).Text)) * 12 / Val(Lbl_FactValue.Caption), "##0.000000")                     '月折旧率
  801.         Case "工作量法"
  802.             '单位工作量折旧额＝（记帐原值－预计净残值）÷工作总量
  803.             '月折旧额＝该月工作总量×单位工作量折旧额
  804.             '注：计算方法在每月固定资产计提折旧时用，在这里将月折旧率和月折旧额文本框的Enable属性赋为False
  805.         Case "固定折旧额折旧法"
  806.             '月折旧额＝记帐原值×月折旧率
  807.             LrText(26).Text = Format(Val(LrText(22).Text) * Val(LrText(27).Text), "##0.00")     '月折旧额
  808.         Case "年数总和法"
  809.             '年折旧率＝｛（预计使用年限－已经使用年限）÷［预计使用年限×（1＋预计使用年限）÷2］｝×100％
  810.             '月折旧率＝年折旧率÷12
  811.             '月折旧额＝（记帐原值－净残值）×月折旧率
  812.             LrText(27).Text = Format(Val(Val(LrText(15).Text) - Val(Val(LrText(25).Text)  12)) / Val(Val(LrText(15).Text) * Val(1 + Val(LrText(15).Text)) / 2) / 12, "##0.000000")
  813.             LrText(26).Text = Format(Val(LrText(22).Text) * (1 - Val(LrText(28).Text)) * Val(LrText(27).Text), "##0.00") '月折旧额
  814.         Case "双倍余额法"
  815.             '年折旧率＝（2÷预计使用年限）×100％
  816.             '年折旧额＝年初固定资产净值×年折旧率
  817.             '月折旧额＝年折旧额÷12
  818.             LrText(26).Text = Format(Val(Lbl_FactValue.Caption) * Val(Val(1 - Val(2 / Val(LrText(15).Text))) ^ Val(Val(LrText(15).Text)  12)) * Val(2 / Val(LrText(15).Text)) / 12, "##0.00") '月折旧额
  819.             LrText(27).Text = Format(Val(2 / Val(LrText(15).Text)) / 12, "##0.000000") '月折旧率
  820.     End Select
  821.     
  822. End Function
  824. '根据资产类别设置取得资产折旧方法、月折旧率、月折旧额和残值率
  825. Function From_Sort()
  826.     
  827.     Set rstemp = New ADODB.Recordset
  828.     rstemp.Open "select * from Gdzc_Sort where FASortCode='" & Trim(LrText(3).Tag) & "'", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
  829.     If Not rstemp.EOF Then
  830.         LrText(15).Text = rstemp!Useyears
  831.         LrText(28).Text = Val(rstemp!SalvageRate) / 100
  832.         LrText(27).Text = Val(rstemp!DeprRate) / 100
  833.         Select Case rstemp!DeprMethod
  834.             Case "01"
  835.                 Com_DeprMethod.Text = "不计提折旧"
  836.             Case "02"
  837.                 Com_DeprMethod.Text = "平均年限法(依净资产计提折旧)"
  838.             Case "03"
  839.                 Com_DeprMethod.Text = "平均年限法(依帐面原值计提折旧)"
  840.             Case "04"
  841.                 Com_DeprMethod.Text = "工作量法"
  842.             Case "05"
  843.                 Com_DeprMethod.Text = "固定折旧额折旧法"
  844.             Case "06"
  845.                 Com_DeprMethod.Text = "年数总和法"
  846.             Case "07"
  847.                 Com_DeprMethod.Text = "双倍余额法"
  848.         End Select
  849.     Else
  850.         LrText(15).Text = ""
  851.         LrText(28).Text = ""
  852.         LrText(27).Text = ""
  853.         Com_DeprMethod.Text = "不计提折旧"
  854.     End If
  855.     rstemp.Close
  856.     Set rstemp = Nothing
  857.     
  858. End Function
  860. '根据用户选择的币种，取得汇率
  861. Function From_Ccur()
  862.     
  863.     Set rstemp = New ADODB.Recordset
  864.     rstemp.Open "select * from Gy_ForeignCurrency where ForeignCurrCode='" & Trim(LrText(12).Tag) & "'", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
  865.     If Not rstemp.EOF Then
  866.         LrText(20).Text = rstemp!accrate
  867.         Ccur_bit = rstemp!ConVertFlag
  868.     Else
  869.         LrText(20).Text = ""
  870.     End If
  871.     rstemp.Close
  872.     Set rstemp = Nothing
  873.     
  874. End Function
  876. '为卡片修改赋值
  877. Function Card_Edit(str As String)
  878.     
  879.     Dim Sqlstr As String
  880.     Dim Custom_Num As Integer
  881.     Dim Fields_Num As Integer          '字段个数变量
  882.     
  883.     Set rstemp = New ADODB.Recordset
  884.     rstemp.Open "select * from Gdzc_Custom where FieldState=1", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
  885.     If Not rstemp.EOF Then
  886.         Custom_Num = rstemp.RecordCount
  887.     End If
  888.     rstemp.Close
  889.     Set rstemp = Nothing
  890.     
  891.     Sqlstr = "SELECT Gdzc_Card.*, Gdzc_JobQuantity.AcivitiesUnit AS AcivitiesUnit, " _
  892.         & "Gdzc_Sort.FASortName AS FASortName,Cwzz_VouchClass.VouchClassName AS VouchClassName, " _
  893.         & "Gdzc_State.FAStateName AS FAStateName,Gy_Department.DeptName AS DeptName, " _
  894.         & "Gdzc_VariationMode.FAVariName AS FAVariName,Gy_ForeignCurrency.ForeignCurrName AS ForeignCurrName, " _
  895.         & "Cwzz_AccCode.Cname AS FACcode_Name,Cwzz_AccCode_1.Cname AS DeprCcode_Name, " _
  896.         & "Cwzz_AccCode_2.Cname AS DeprMoneyCcode_Name FROM Gdzc_Card LEFT OUTER JOIN " _
  897.         & "Gdzc_VariationMode ON Gdzc_Card.FAVariCode = Gdzc_VariationMode.FAVariCode LEFT OUTER JOIN " _
  898.         & "Gdzc_Sort ON Gdzc_Card.FASortCode = Gdzc_Sort.FASortCode LEFT OUTER JOIN Gy_Department ON " _
  899.         & "Gdzc_Card.DeptCode = Gy_Department.DeptCode LEFT OUTER JOIN " _
  900.         & "Gdzc_State ON Gdzc_Card.FAStateCode = Gdzc_State.FaStateCode LEFT OUTER JOIN " _
  901.         & "Gy_ForeignCurrency ON Gdzc_Card.ForeignCurrCode = Gy_ForeignCurrency.ForeignCurrCode LEFT OUTER JOIN " _
  902.         & "Cwzz_VouchClass ON Gdzc_Card.VouchClassCode = Cwzz_VouchClass.VouchClassCode LEFT OUTER JOIN " _
  903.         & "Gdzc_JobQuantity ON Gdzc_Card.CardCode = Gdzc_JobQuantity.CardCode LEFT OUTER JOIN " _
  904.         & "Cwzz_AccCode ON Gdzc_Card.FACcode = Cwzz_AccCode.Ccode LEFT OUTER JOIN Cwzz_AccCode Cwzz_AccCode_1 ON " _
  905.         & "Gdzc_Card.DeprCcode = Cwzz_AccCode_1.Ccode LEFT OUTER JOIN Cwzz_AccCode Cwzz_AccCode_2 ON " _
  906.         & "Gdzc_Card.DeprMoneyCcode = Cwzz_AccCode_2.Ccode"
  907.     Sqlstr = Sqlstr & " where Gdzc_Card.CardCode='" & Trim(str) & "'"
  908.     Set rstemp = New ADODB.Recordset
  909.     rstemp.Open Sqlstr, Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
  910.     With rstemp
  911.         If Not rstemp.EOF Then
  912.             LrText(0).Text = Trim(!BeginUsedate & "")               '开始使用日期
  913.             LrText(1).Text = Trim(!WriteDate & "")                  '记帐日期
  914.             LrText(2).Text = Trim(!FAName & "")                     '资产名称
  915.             LrText(3).Text = Trim(!FASortName & "")                 '资产类别名称
  916.             LrText(3).Tag = Trim(!FASortCode & "")                  '资产类别编号
  917.             LrText(4).Text = Trim(!Measureunit & "")                '计量单位
  918.             LrText(5).Text = Trim(!DeptName & "")                   '部门名称
  919.             LrText(5).Tag = Trim(!DeptCode & "")                    '部门编号
  920.             LrText(6).Text = Trim(!FAVariName & "")                 '增加方式名称
  921.             LrText(6).Tag = Trim(!FAVariCode & "")                  '增加方式编号
  922.             LrText(7).Text = Trim(!FAStateName & "")                '使用状况名称
  923.             LrText(7).Tag = Trim(!FAStateCode & "")                 '使用状况编号
  924.             LrText(8).Text = Trim(!FACcode_Name & "")               '资产科目名称
  925.             LrText(8).Tag = Trim(!FACcode & "")                     '资产科目编号
  926.             LrText(9).Text = Trim(!DeprCcode_Name & "")             '累计折旧名称
  927.             LrText(9).Tag = Trim(!DeprCcode & "")                   '累计折旧编号
  928.             LrText(10).Text = Trim(!DeprMoneyCcode_Name & "")       '折旧费用科目名称
  929.             LrText(10).Tag = Trim(!DeprMoneyCcode & "")             '折旧费用科目编号
  930.             LrText(11).Text = Trim(!VouchClassName & "")            '凭证类别名称
  931.             LrText(11).Tag = Trim(!VouchClassCode & "")             '凭证类别编号
  932.             LrText(12).Text = Trim(!ForeignCurrName & "")           '币种类别名称
  933.             LrText(12).Tag = !ForeignCurrCode                       '币种类别编号
  934.             LrText(13).Text = Trim(!FACode & "")                    '资产编号
  935.             LrText(14).Text = !FAQuantity                           '资产数量
  936.             LrText(15).Text = !Useyears                             '使用年限
  937.             LrText(16).Text = Trim(!SpecificationMode & "")         '规格型号
  938.             LrText(17).Text = Trim(!Product & "")                   '生产商
  939.             LrText(18).Text = Trim(!SetLocaNum & "")                '设备位号
  940.             LrText(19).Text = Trim(!VouchNo & "")                   '凭证号
  941.             LrText(20).Text = !accrate                              '记帐汇率
  942.             LrText(21).Text = !ForeignValue                         '外币金额
  943.             LrText(22).Text = !FAValue                              '资产原值
  944.             LrText(23).Text = !DeprSum                              '累计折旧
  945.             LrText(24).Text = !FAValue                              '本位币值
  946.             LrText(25).Text = !deprmothes                           '折旧月数
  947.             LrText(26).Text = !DeprValue                            '月折旧额
  948.             LrText(27).Text = !DeprRate                             '月折旧率
  949.             LrText(28).Text = !SalRate                              '残值率
  950.             LrText(29).Text = !SalValue                             '净残值
  951.             LrText(30).Text = !Activities                           '工作总量
  952.             LrText(31).Text = Trim(!AcivitiesUnit & "")             '工作量单位
  953.             LrText(32).Text = !AcitvitiesSum                        '累计工作量
  954.             Lbl_Num.Caption = !CardCode                             '卡片编号
  955.             Lbl_Year.Caption = !Year                                '会计年度
  956.             Lbl_Period.Caption = Format(!Period, "00")              '会计期间
  957.             Lbl_Operator.Caption = !Opreator                        '操作员
  958.             Lbl_FactValue.Caption = !FactValue                      '净资产
  959.             Select Case .Fields("DeprMethod")                       '      折旧方法                                          '折旧方法
  960.                 Case "01"
  961.                     Com_DeprMethod.Text = "不计提折旧"
  962.                 Case "02"
  963.                     Com_DeprMethod.Text = "平均年限法(依净资产计提折旧)"
  964.                 Case "03"
  965.                     Com_DeprMethod.Text = "平均年限法(依帐面原值计提折旧)"
  966.                 Case "04"
  967.                     Com_DeprMethod.Text = "工作量法"
  968.                 Case "05"
  969.                     Com_DeprMethod.Text = "固定折旧额折旧法"
  970.                 Case "06"
  971.                     Com_DeprMethod.Text = "年数总和法"
  972.                 Case "07"
  973.                     Com_DeprMethod.Text = "双倍余额法"
  974.             End Select
  975.             If !CardType = True Then
  976.                 Com_Type.Text = "新增固定资产"                      '卡片类型
  977.             Else
  978.                 Com_Type.Text = "原始卡片录入"
  979.             End If
  980.             
  981.             If Val(Custom_Num) > 0 Then
  982.                 For Fields_Num = 1 To Custom_Num                        '用户自定义属性
  983.                     If Trim(.Fields("zdy" & Val(Val(Fields_Num))) & " ") = "" Then
  984.                         LrText(Val(Fields_Num) + 32).Text = ""
  985.                     Else
  986.                         LrText(Val(Fields_Num) + 32).Text = Trim(.Fields("zdy" & Val(Val(Fields_Num))) & " ")
  987.                     End If
  988.                 Next Fields_Num
  989.             End If
  990.         End If
  991.     End With
  992.     rstemp.Close
  993.     Set rstemp = Nothing
  994.     
  995.     Me.AutoRedraw = True
  996.     
  997. End Function
  999. '录入完毕，清空录入文本框
  1000. Function Txt_Clear()
  1002.     Dim i As Integer                '文本框索引
  1003.     
  1004.     For i = 0 To LrText.count - 1
  1005.         If Trim(str_State) = "1" Then
  1006.             If i = 1 Then i = 2
  1007.             If i = 3 Then i = 4
  1008.             If i = 5 Then i = 8
  1009.             If i = 12 Then i = 13
  1010.             If i = 15 Then i = 16
  1011.             If i = 20 Then i = 21
  1012.         End If
  1013.         If i = 12 Then i = 13
  1014.         If i = 20 Then i = 21
  1015.         LrText(i).Text = ""
  1016.     Next
  1017.     Lbl_FactValue.Caption = ""
  1018.     LrText(14).Text = "1"
  1019.     LrText(1).Text = Xtrq
  1020.     
  1021. End Function
  1023. '移动记录指针函数
  1024. Function Recordset_Move(Rs_int As Integer)
  1025.     
  1026.     Dim Rs_Temp As ADODB.Recordset
  1027.     
  1028.     Set Rs_Temp = New ADODB.Recordset
  1029.     Rs_Temp.Open "select * from Gdzc_card order by CardCode", Cw_DataEnvi.DataConnect, adOpenKeyset, adLockOptimistic
  1030.     Rs_Temp.Find "cardcode='" & Trim(Num_text.Text) & "'"
  1031.     If Rs_Temp.EOF And Rs_Temp.BOF Then
  1032.        Tsxx = "没有需要操作的卡片!"
  1033.        Call Xtxxts(Tsxx, 0, 4)
  1034.        Exit Function
  1035.     Else
  1036.         With Rs_Temp
  1037.             Select Case Rs_int
  1038.                 Case 1
  1039.                     .MoveFirst
  1040.                     SzToolbar.Buttons("first").Enabled = False
  1041.                     SzToolbar.Buttons("prev").Enabled = False
  1042.                     SzToolbar.Buttons("next").Enabled = True
  1043.                     SzToolbar.Buttons("last").Enabled = True
  1044.                 Case 2
  1045.                     .MovePrevious
  1046.                     If .BOF And .RecordCount > 0 Then
  1047.                         .MoveFirst
  1048.                         SzToolbar.Buttons("first").Enabled = False
  1049.                         SzToolbar.Buttons("prev").Enabled = False
  1050.                         SzToolbar.Buttons("next").Enabled = True
  1051.                         SzToolbar.Buttons("last").Enabled = True
  1052.                     Else
  1053.                         SzToolbar.Buttons("first").Enabled = True
  1054.                         SzToolbar.Buttons("prev").Enabled = True
  1055.                         SzToolbar.Buttons("next").Enabled = True
  1056.                         SzToolbar.Buttons("last").Enabled = True
  1057.                     End If
  1058.                 Case 3
  1059.                     .MoveNext
  1060.                     If .EOF And .RecordCount > 0 Then
  1061.                         .MoveLast
  1062.                         SzToolbar.Buttons("first").Enabled = True
  1063.                         SzToolbar.Buttons("prev").Enabled = True
  1064.                         SzToolbar.Buttons("next").Enabled = False
  1065.                         SzToolbar.Buttons("last").Enabled = False
  1066.                     Else
  1067.                         SzToolbar.Buttons("first").Enabled = True
  1068.                         SzToolbar.Buttons("prev").Enabled = True
  1069.                         SzToolbar.Buttons("next").Enabled = True
  1070.                         SzToolbar.Buttons("last").Enabled = True
  1071.                     End If
  1072.                 Case 4
  1073.                     .MoveLast
  1074.                     SzToolbar.Buttons("first").Enabled = True
  1075.                     SzToolbar.Buttons("prev").Enabled = True
  1076.                     SzToolbar.Buttons("next").Enabled = False
  1077.                     SzToolbar.Buttons("last").Enabled = False
  1078.             End Select
  1079.         End With
  1080.         Call Card_Edit(Rs_Temp!CardCode)
  1081.         Num_text.Text = Rs_Temp!CardCode
  1082.     End If
  1083.     Rs_Temp.Close
  1084.     Set Rs_Temp = Nothing
  1085.     
  1086. End Function
  1088. '对文本框加锁
  1089. Function Txt_Lock()
  1091.     If Trim(str_State) = "3" Or Trim(str_State) = "4" Then
  1092.         For i = 0 To LrText.count - 1
  1093.             LrText(i).Enabled = False
  1094.         Next i
  1095.         Com_DeprMethod.Enabled = False
  1096.         Com_Type.Enabled = False
  1097.     ElseIf Trim(str_State) = "2" Then
  1098.         If Txt_Bit = False Then
  1099.             For i = 0 To LrText.count - 1
  1100.                 If i = 0 Then i = 1
  1101.                 If i = 4 Then i = 5
  1102.                 If i = 8 Then i = 12
  1103.                 If i = 16 Then i = 20
  1104.                 If i = 31 Then i = 32
  1105.                 Com_DeprMethod.Enabled = False
  1106.                 Com_Type.Enabled = False
  1107.                 LrText(i).Enabled = False
  1108.             Next i
  1109.         End If
  1110.     End If
  1111.     
  1112. End Function
  1114. '解锁
  1115. Function Open_Lock()
  1117.     For i = 0 To LrText.count - 1
  1118.         LrText(i).Enabled = True
  1119.     Next i
  1120.     
  1121.     If Trim(Com_DeprMethod.Text) = "工作量法" Then
  1122.         LrText(30).Enabled = True
  1123.         LrText(31).Enabled = True
  1124.         LrText(32).Enabled = True
  1125.     Else
  1126.         LrText(30).Enabled = False
  1127.         LrText(31).Enabled = False
  1128.         LrText(32).Enabled = False
  1129.     End If
  1130.     
  1131.     If Trim(Com_DeprMethod.Text) = "不计提折旧" Then
  1132.         LrText(26).Enabled = False
  1133.         LrText(27).Enabled = False
  1134.     Else
  1135.         LrText(26).Enabled = True
  1136.         LrText(27).Enabled = True
  1137.     End If
  1138.     
  1139.     Com_DeprMethod.Enabled = True
  1140.     Com_Type.Enabled = True
  1141.     
  1142. End Function
  1144. '卡片删除操作
  1145. Function Card_Del()
  1147.     Dim FAValue_Temp As Double              '修改原资产原值变量
  1148.     Dim DeprSum_temp As Double              '修改原累计折旧变量
  1149.     Dim DeptCode_temp As String             '部门编号
  1150.     Dim FASortCode_temp As String           '资产类别编号
  1151.     Dim str As String
  1152.     Dim rs As ADODB.Recordset
  1153.     
  1154.     '判断用户是否有此功能执行权限,如有则写上机日志(进入)
  1155.     If Not Security_Log(Str_RightEdit, Xtczybm, 1, True) Then
  1156.         Exit Function
  1157.     End If
  1158.     
  1159.     Set rstemp = New ADODB.Recordset
  1160.     rstemp.Open "select * from Gdzc_Variation where FAVariCode='00501' and Cardcode='" & Trim(Lbl_Num.Caption) & "'", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
  1161.     If Not rstemp.EOF Then
  1162.         Tsxx = "该资产卡片已经计提折旧,不能删除!"
  1163.         Call Xtxxts(Tsxx, 0, 4)
  1164.         Exit Function
  1165.     End If
  1166.     rstemp.Close
  1167.     Set rstemp = Nothing
  1168.     
  1169.     Set rstemp = New ADODB.Recordset
  1170.     rstemp.Open "select * from gdzc_card where CardCode='" & Trim(Lbl_Num.Caption) & "' and year=" & CInt(Xtyear) & " and period=" & CInt(Xtmm), Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
  1171.     If rstemp.EOF Then
  1172.        Tsxx = "请操作本会计期间数据!"
  1173.        Call Xtxxts(Tsxx, 0, 4)
  1174.        Exit Function
  1175.     End If
  1176.     rstemp.Close
  1177.     Set rstemp = Nothing
  1178.     
  1179.     If MsgBox("真的要删除该记录吗?", vbOKCancel + vbDefaultButton2 + vbQuestion, "百利/ERP5.0-固定资产") = vbOK Then
  1180.         
  1181.         On Error GoTo Cwcl
  1182.         Cw_DataEnvi.DataConnect.BeginTrans
  1184.         '删除资产卡片
  1185.         Set rstemp = New ADODB.Recordset
  1186.         rstemp.Open "select * from Gdzc_Card where CardCode='" & Trim(Lbl_Num.Caption) & "'", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
  1187.         If Not rstemp.EOF Then
  1188.             FAValue_Temp = rstemp.Fields("FAValue")                                 '借助变量存储修改资产原值
  1189.             DeprSum_temp = rstemp.Fields("DeprSum")
  1190.             DeptCode_temp = rstemp.Fields("DeptCode")
  1191.             FASortCode_temp = rstemp.Fields("FASortCode")
  1192.             rstemp.Delete
  1193.             rstemp.Update
  1194.         Else
  1195.             Tsxx = "请操作本会计期间的记录!"
  1196.             Call Xtxxts(Tsxx, 0, 4)
  1197.             Exit Function
  1198.         End If
  1199.         rstemp.Close
  1200.         Set rstemp = Nothing
  1201.         
  1202.         '删除工作量表
  1203.         Set rstemp = New ADODB.Recordset
  1204.         With rstemp
  1205.             .Open "select * from Gdzc_jobquantity where CardCode='" & Trim(Lbl_Num.Caption) & "'", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
  1206.             If Not .EOF Then
  1207.                 .Delete
  1208.                 .Update
  1209.             End If
  1210.         End With
  1211.         rstemp.Close
  1212.         Set rstemp = Nothing
  1213.         
  1214.         '删除会计明细表记录
  1215.         Set rstemp = New ADODB.Recordset
  1216.         With rstemp
  1217.             .Open "select * from Gdzc_DetailedForm where CardCode='" & Trim(Lbl_Num.Caption) & "'", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
  1218.             .Delete
  1219.             .Update
  1220.         End With
  1221.         rstemp.Close
  1222.         Set rstemp = Nothing
  1223.         
  1224.         '修改资产汇总表记录
  1225.         Set rstemp = New ADODB.Recordset
  1226.         str = "select * from Gdzc_Total where DeptCode='" & DeptCode_temp & "' and FASortCode='" & FASortCode_temp & "'"
  1227.         rstemp.Open str, Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
  1228.         With rstemp
  1229.             If Not .EOF Then
  1230.                 If Val(.Fields("FAValueEndM")) = Val(FAValue_Temp) Then
  1231.                     .Delete
  1232.                     .Update
  1233.                 Else
  1234.                     .Fields("FAValueEndM") = CCur(Format(Val(.Fields("FAValueEndM")) - FAValue_Temp, "##0.00"))       '月末原值
  1235.                     .Fields("DeprSumEndM") = CCur(Val(.Fields("DeprSumEndM")) - DeprSum_temp)  '月末累计折旧
  1236.                     .Fields("FAValueInM") = CCur(Val(.Fields("FAValueInM")) - FAValue_Temp)     '本期增加原值
  1237.                     .Fields("DeprSumInM") = CCur(Val(.Fields("DeprSumInM")) - DeprSum_temp)      '本期累计折旧增加
  1238.                     .Update
  1239.                 End If
  1240.             End If
  1241.         End With
  1242.         rstemp.Close
  1243.         Set rstemp = Nothing
  1244.         
  1245.         '删除资产变动单据表
  1246.         Set rstemp = New ADODB.Recordset
  1247.         With rstemp
  1248.             .Open "Select * from Gdzc_Variation where CardCode='" & Trim(Lbl_Num.Caption) & "'", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
  1249.             While Not .EOF
  1250.                 .Delete
  1251.                 .Update
  1252.                 .MoveNext
  1253.             Wend
  1254.         End With
  1255.         rstemp.Close
  1256.         Set rstemp = Nothing
  1257.         
  1258.         '判断并修改自定义属性表
  1259.         Set rstemp = New ADODB.Recordset
  1260.         rstemp.Open "select * from gdzc_Custom where FieldState='1'", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
  1261.         While Not rstemp.EOF
  1262.             Set rs = New ADODB.Recordset
  1263.             rs.Open "select * from gdzc_card where " & Trim(rstemp!FieldCode) & "<>''", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
  1264.             If rs.EOF Then
  1265.                 rstemp!WhetherNull = False
  1266.                 rstemp.Update
  1267.             End If
  1268.             rs.Close
  1269.             Set rs = Nothing
  1270.             
  1271.             rstemp.MoveNext
  1272.         Wend
  1273.         rstemp.Close
  1274.         Set rstemp = Nothing
  1275.         
  1276.         Cw_DataEnvi.DataConnect.CommitTrans
  1277.                         
  1278.         Call Recordset_Move(1)
  1279.         Exit Function
  1280.     Else
  1281.         Exit Function
  1282.     End If
  1283. Cwcl:
  1284.     Cw_DataEnvi.DataConnect.RollbackTrans
  1285.     Tsxx = "删除出错，系统自动返回删除前状态！"
  1286.     Call Xtxxts(Tsxx, 0, 1)
  1287.     Exit Function
  1288.     
  1289. End Function
  1291. '是否允许修改
  1292. Function Txt_Bit() As Boolean
  1293.     
  1294.     Txt_Bit = False
  1295.     Set rstemp = New ADODB.Recordset
  1296.     rstemp.Open "select * from gdzc_card where CardCode='" & Trim(Lbl_Num.Caption) & "' and year=" & CInt(Xtyear) & " and period=" & CInt(Xtmm), Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
  1297.     If rstemp.EOF Then
  1298.        If Trim(str_State) <> "2" Then Exit Function
  1299.        Tsxx = "非本会计期间录入卡片只能修改部分数据!"
  1300.        Call Xtxxts(Tsxx, 0, 4)
  1301.        Exit Function
  1302.     Else
  1303.         Txt_Bit = True
  1304.     End If
  1305.     rstemp.Close
  1306.     
  1307.     Set rstemp = New ADODB.Recordset
  1308.     rstemp.Open "select * from Gdzc_Variation where FAVariCode='00501' and Cardcode='" & Trim(Lbl_Num.Caption) & "'", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
  1309.     If Not rstemp.EOF Then
  1310.         Tsxx = "该资产卡片已经计提折旧,只能修改部分数据!"
  1311.         Call Xtxxts(Tsxx, 0, 4)
  1312.         Txt_Bit = False
  1313.     End If
  1314.     rstemp.Close
  1315.     Set rstemp = Nothing
  1316.        
  1317. End Function
  1319. '本月是否已经进行计提折旧
  1320. Function If_Add() As Boolean
  1322.     If_Add = False
  1323.     
  1324.     Set rstemp = New ADODB.Recordset
  1325.     rstemp.Open "select * from Gdzc_card where DeprFlag='1'", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
  1326.     If rstemp.EOF Then
  1327.         If_Add = True
  1328.     Else
  1329.         Tsxx = "固定资产已计提折旧,未执行月末结帐!"
  1330.         Call Xtxxts(Tsxx, 0, 4)
  1331.         Exit Function
  1332.     End If
  1333.     rstemp.Close
  1334.     Set rstemp = Nothing
  1335.     
  1336.     If_Add = True
  1337.     
  1338. End Function
  1339. '*******************以上区域为编写自定义过程区域**********************
  1341. '************以下为文本框录入处理程序(固定不变部分)*************'
  1342. Private Sub Wbklrwbcl(Index As Integer)    '文本框录入事后处理程序
  1344.     '以下为依据实际情况自定义部分[
  1345.   
  1346.     '在此填写文本框录入事后处理程序
  1347.    
  1348.     ']以上为依据实际情况自定义部分
  1350. End Sub
  1352. Private Sub LrText_Change(Index As Integer)
  1354.     TextValiJudgeLock(Index) = False    '打开有效性判断锁
  1355.     
  1356.     '限制字段录入长度
  1357.           
  1358.     TextChangeLock = True  '加锁(防止执行Lrtext_Change)
  1359.     Select Case Textint(Index, 1)
  1360.         Case 8, 11      '金额型
  1361.             Call Sjgskz(LrText(Index), Xtjezws - Xtjexsws - 1, Xtjexsws)
  1362.         Case 9, 12      '数量型
  1363.             Call Sjgskz(LrText(Index), Xtslzws - Xtslxsws - 1, Xtslxsws)
  1364.         Case 10          '单价型
  1365.             Call Sjgskz(LrText(Index), Xtdjzws - Xtdjxsws - 1, Xtdjxsws)
  1366.         Case Else        '其他小数类型控制
  1367.             If Textint(Index, 6) <> 0 Or Textint(Index, 7) <> 0 Then
  1368.                 Call Sjgskz(LrText(Index), Textint(Index, 6), Textint(Index, 7))
  1369.             End If
  1370.     End Select
  1371.     TextChangeLock = False '解锁
  1372.     
  1373. End Sub
  1375. Private Sub LrText_GotFocus(Index As Integer)                                                 '文本框得到焦点,显示相应信息
  1376.     
  1377.     Call TextShow(Index)
  1378.     CurTextIndex = Index
  1379.     LrText(Index).SelStart = Len(LrText(Index))
  1381. End Sub
  1383. Private Sub LrText_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)            '字段按F2键提供帮助
  1384.     
  1385.     Select Case KeyCode
  1386.         Case vbKeyF2
  1387.             Call Text_Help(Index)
  1388.             
  1389.             '根据资产类别设置取得资产折旧方法、月折旧率、月折旧额和残值率
  1390.             If Index = 3 Then
  1391.                 Call From_Sort
  1392.             End If
  1393.             
  1394.             '根据用户选择的币种，取得汇率
  1395.             Call From_Ccur
  1396.     End Select
  1398. End Sub
  1400. Private Sub LrText_KeyPress(Index As Integer, KeyAscii As Integer)                            '文本框录入事中控制
  1401.     Call InputFieldLimit(LrText(Index), Textint(Index, 1), KeyAscii)
  1402. End Sub
  1404. Private Sub LrText_LostFocus(Index As Integer)                                                '文本框失去焦点进行有效性判断及相应处理
  1405.     
  1406.     If Textint(Index, 9) = 0 Or Textint(Index, 9) = 1 Then '事中判断
  1407.         Call TextYxxpd(Index)
  1408.     End If
  1409.     
  1410.     '//用户自定义判断过程
  1411.     
  1412.     '根据用户输入的外币金额，自动计算取得资产原值、本位币值
  1413.     If Index = 20 Or Index = 21 Then
  1414.         If Trim(LrText(20).Text) <> "" And Trim(LrText(21).Text) <> "" And Trim(LrText(22).Text) = "" Then
  1415.             If Ccur_bit = False Then
  1416.                 LrText(24).Text = Format(Val(LrText(20).Text) * Val(LrText(21).Text), "##0.00")
  1417.                 LrText(22).Text = Format(Val(LrText(20).Text) * Val(LrText(21).Text), "##0.00")
  1418.             Else
  1419.                 LrText(24).Text = Format(Val(LrText(21).Text) / Val(LrText(20).Text), "##0.00")
  1420.                 LrText(22).Text = Format(Val(LrText(21).Text) / Val(LrText(20).Text), "##0.00")
  1421.             End If
  1422.         End If
  1423.     End If
  1424.     
  1425.     '根据资产折旧方法，以及修改折旧方法所需要的各录入数据，取得月折旧额和月折旧率
  1426.     If Index = 15 Or Index = 22 Or Index = 25 Or Index = 28 Then
  1427.         Call DeprMethod
  1428.     End If
  1429.     If Index = 27 And Trim(Com_DeprMethod.Text) = "固定折旧额折旧法" Then
  1430.         Call DeprMethod
  1431.     End If
  1432.     
  1433.     '取得净资产
  1434.     If Index = 22 Or Index = 23 Then
  1435.         Lbl_FactValue.Caption = Format(Val(LrText(22).Text) - Val(LrText(23).Text), "#0.00")
  1436.         If Trim(LrText(20).Text & "") <> "" And Trim(LrText(22).Text) <> "" And Trim(LrText(21).Text) = "" Then
  1437.             If Ccur_bit = False Then
  1438.                 LrText(21).Text = Format(Val(LrText(22).Text) / Val(LrText(20).Text), "##0.00")
  1439.             Else
  1440.                 LrText(21).Text = Format(Val(LrText(22).Text) * Val(LrText(20).Text), "##0.00")
  1441.             End If
  1442.         End If
  1443.     End If
  1444.     
  1445.     '取得净残值
  1446.     If Index = 22 Or Index = 28 Then
  1447.         LrText(29).Text = Format(Val(LrText(22).Text) * Val(LrText(28).Text), "##0.00")
  1448.     End If
  1449.     
  1450.     '//自定义判断结束
  1451.     
  1452.     '屏蔽程序改变控制
  1453.     If TextChangeLock Then
  1454.         Exit Sub
  1455.     End If
  1456.     
  1457. End Sub
  1459. Private Function Bclrsj() As Boolean                   '判断录入数据有效性,并保存数据
  1460.     
  1461.     Dim Jsqte As Integer
  1462.     
  1463.     '对文本框录入内容进行为零和为空判断(固定不变)
  1464.     For Jsqte = 0 To Max_Text_Index
  1465.         If Textint(Jsqte, 8) = 1 Then     '字段不能为空
  1466.             If Len(Trim(LrText(Jsqte).Text)) = 0 Then
  1467.                 Tsxx = Textstr(Jsqte, 7) & "不能为空!"
  1468.                 Call Xtxxts(Tsxx, 0, 1)
  1469.                 LrText(Jsqte).SetFocus
  1470.                 Bclrsj = False
  1471.                 Exit Function
  1472.             End If
  1473.         Else
  1474.             If Textint(Jsqte, 8) = 2 Then   '字段不能为零
  1475.                 If Val(Trim(LrText(Jsqte).Text)) = 0 Then
  1476.                     Tsxx = Textstr(Jsqte, 7) & "不能为零!"
  1477.                     Call Xtxxts(Tsxx, 0, 1)
  1478.                     LrText(Jsqte).SetFocus
  1479.                     Bclrsj = False
  1480.                     Exit Function
  1481.                 End If
  1482.             End If
  1483.         End If
  1484.     Next Jsqte
  1485.     
  1486.     '对需要进行事后判断的文本框录入内容进行有效性判断 (固定不变)
  1487.     For Jsqte = 0 To Max_Text_Index
  1488.         If Textint(Jsqte, 9) = 0 Or Textint(Jsqte, 9) = 2 Then
  1489.             If Not TextYxxpd(Jsqte) Then
  1490.                 Exit Function
  1491.             End If
  1492.         End If
  1493.     Next Jsqte
  1494.     
  1495.     '//以下为自定义判断过程
  1496.     
  1497.     '判断资产编号不能重复
  1498.     Set rstemp = New ADODB.Recordset
  1499.     If str_State = "1" Then
  1500.         rstemp.Open "select * from gdzc_card where FACode='" & Trim(LrText(13).Text) & "'", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
  1501.     Else
  1502.         rstemp.Open "select * from gdzc_card where FACode='" & Trim(LrText(13).Text) & "' and CardCode<>'" & Trim(Lbl_Num.Caption) & "'", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
  1503.     End If
  1504.     If Not rstemp.EOF Then
  1505.         Tsxx = "资产编号不能重复!"
  1506.         Call Xtxxts(Tsxx, 0, 4)
  1507.         LrText(13).Text = ""
  1508.         LrText(13).SetFocus
  1509.         Exit Function
  1510.     End If
  1511.     rstemp.Close
  1512.     Set rstemp = Nothing
  1514.     '累计折旧不能大于资产原值
  1515.     If Val(LrText(22).Text) - Val(LrText(23).Text) < 0 Then
  1516.         Tsxx = "累计折旧不能大于资产原值!"
  1517.         Call Xtxxts(Tsxx, 0, 4)
  1518.         LrText(23).SetFocus
  1519.         Exit Function
  1520.     End If
  1521.     
  1522.     '折旧月数不能大于使用年限×12
  1523.     If Val(Val(LrText(25).Text)) > Val(Val(LrText(15).Text) * 12) Then
  1524.         Tsxx = "折旧月数的年限不能大于使用年限!"
  1525.         Call Xtxxts(Tsxx, 0, 4)
  1526.         LrText(25).SetFocus
  1527.         Exit Function
  1528.     End If
  1529.     
  1530.     '当资产折旧方法为“工作量法”时，工作总量和工作量单位不能为空
  1531.     If Trim(Com_DeprMethod.Text) = "工作量法" Then
  1532.         If Trim(LrText(30).Text) = "" Then
  1533.             Tsxx = "工作总量不能为空!"
  1534.             Call Xtxxts(Tsxx, 0, 4)
  1535.             LrText(30).SetFocus
  1536.             Exit Function
  1537.         End If
  1538.         If Trim(LrText(31).Text) = "" Then
  1539.             Tsxx = "工作量单位不能为空!"
  1540.             Call Xtxxts(Tsxx, 0, 4)
  1541.             LrText(31).SetFocus
  1542.             Exit Function
  1543.         End If
  1544.     End If
  1545.     
  1546.     '当资产折旧方法为“固定折旧额法”时，月折旧额不能为空
  1547.     If Trim(Com_DeprMethod.Text) = "固定折旧额折旧法" Then
  1548.         If Trim(LrText(26).Text) = "" Then
  1549.             Tsxx = "月折旧额不能为空!"
  1550.             Call Xtxxts(Tsxx, 0, 4)
  1551.             LrText(26).SetFocus
  1552.             Exit Function
  1553.         End If
  1554.     End If
  1555.     
  1556.     '日期判断
  1557.     If Trim(LrText(0).Text) <> "" Then
  1558.         If Val(Year(LrText(0).Text)) > Val(Xtyear) Then
  1559.             Tsxx = "使用日期不能大于本会计年度!"
  1560.             Call Xtxxts(Tsxx, 0, 4)
  1561.             LrText(0).Text = ""
  1562.             LrText(0).SetFocus
  1563.             Exit Function
  1564.         End If
  1565.         If Val(Year(LrText(0).Text)) > Val(Xtyear) And Val(Month(LrText(0).Text)) > Val(Xtmm) Then
  1566.             Tsxx = "使用日期不能大于本会计期间!"
  1567.             Call Xtxxts(Tsxx, 0, 4)
  1568.             LrText(0).Text = ""
  1569.             LrText(0).SetFocus
  1570.             Exit Function
  1571.         End If
  1572.     End If
  1573.     
  1574.     '日期判断
  1575.     If Trim(LrText(1).Text) <> "" Then
  1576.         If Val(Year(LrText(1).Text)) > Val(Xtyear) Then
  1577.             Tsxx = "记帐日期不能大于本会计年度!"
  1578.             Call Xtxxts(Tsxx, 0, 4)
  1579.             LrText(1).Text = ""
  1580.             LrText(1).SetFocus
  1581.             Exit Function
  1582.         End If
  1583.         If Val(Year(LrText(1).Text)) > Val(Xtyear) And Val(Month(LrText(1).Text)) > Val(Xtmm) Then
  1584.             Tsxx = "记帐日期不能大于本会计期间!"
  1585.             Call Xtxxts(Tsxx, 0, 4)
  1586.             LrText(1).Text = ""
  1587.             LrText(1).SetFocus
  1588.             Exit Function
  1589.         End If
  1590.     End If
  1592.     '自定义判断
  1593.     Dim Define_int As Integer
  1594.     Dim Define_tmep As Double
  1595.     For Define_int = 33 To 52
  1596.         If LrText(Define_int).Visible = True Then
  1597.             If Trim(LrText(Define_int).Text & "") <> "" Then
  1598.                 Set rs = New ADODB.Recordset
  1599.                 rs.Open "select * from gdzc_custom where FieldCode='" & Trim(LrText(Define_int).Tag) & "' and FieldState='1'", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
  1600.                 If Not rs.EOF Then
  1601.                     If rs!datatype = 3 Then
  1602.                         Define_tmep = IIf(rs!intlength < 1, 1, IIf(rs!intlength < 2, 10, IIf(rs!intlength < 3, 100, IIf(rs!intlength < 4, 1000, IIf(rs!intlength < 5, 10000, _
  1603.                                     IIf(rs!intlength < 6, 100000, IIf(rs!intlength < 7, 1000000, IIf(rs!intlength < 8, 10000000, IIf(rs!intlength < 9, 100000000, IIf(rs!intlength < 10, 1000000000, 100000000000#))))))))))
  1604.                         If Val(LrText(Define_int).Text) > Val(Define_tmep) Then
  1605.                             Tsxx = "您的输入值不能超过自定义最大值!"
  1606.                             Call Xtxxts(Tsxx, 0, 4)
  1607.                             LrText(Define_int).Text = ""
  1608.                             LrText(Define_int).SetFocus
  1609.                             Exit Function
  1610.                         End If
  1611.                     ElseIf rs!datatype = 5 Then
  1612.                         If Val(Year(Trim(LrText(Define_int).Text) & "")) > Val(Xtyear) Then
  1613.                             Tsxx = "日期不能大于本会计年度!"
  1614.                             Call Xtxxts(Tsxx, 0, 4)
  1615.                             LrText(Define_int).Text = ""
  1616.                             LrText(Define_int).SetFocus
  1617.                             Exit Function
  1618.                         End If
  1619.                         If Val(Year(Trim(LrText(Define_int).Text) & "")) > Val(Xtyear) And Val(Month(LrText(Define_int).Text)) > Val(Xtmm) Then
  1620.                             Tsxx = "日期不能大于本会计期间!"
  1621.                             Call Xtxxts(Tsxx, 0, 4)
  1622.                             LrText(Define_int).Text = ""
  1623.                             LrText(Define_int).SetFocus
  1624.                             Exit Function
  1625.                         End If
  1626.                     End If
  1627.                 End If
  1628.                 rs.Close
  1629.                 Set rs = Nothing
  1630.             End If
  1631.         End If
  1632.     Next Define_int
  1633.    
  1634.    '//以上为自定义判断过程
  1635.       
  1636.     '录入数据保存
  1637.     Call Lrbc
  1638.     
  1639.     
  1640.     '保存记录成功,函数返回真值
  1641.     Bclrsj = True
  1642.     Exit Function
  1643.     
  1644. End Function
  1646. Private Sub SzToolbar_ButtonClick(ByVal Button As MSComctlLib.Button)
  1647.     
  1648.     Select Case Button.Key
  1649.         Case "zj"                           '新增
  1650.             '判断用户是否有此功能执行权限,如有则写上机日志(进入)
  1651.             If Not Security_Log(Str_RightEdit, Xtczybm, 1, True) Then
  1652.                 Exit Sub
  1653.             End If
  1654.             
  1655.             If If_Add = True Then
  1656.                 Call Txt_Clear
  1657.                 str_State = "1"
  1658.                 Call Zdbm
  1659.                 Me.AutoRedraw = False
  1660.                 SetToolState
  1661.                 LrText(13).SetFocus
  1662.             End If
  1663.         Case "xg"                           '修改
  1664.             '判断用户是否有此功能执行权限,如有则写上机日志(进入)
  1665.             If Not Security_Log(Str_RightEdit, Xtczybm, 1, True) Then
  1666.                 Exit Sub
  1667.             End If
  1668.             If If_Add = True Then
  1669.                 str_State = "2"
  1670.                 Me.AutoRedraw = False
  1671.                 SetToolState
  1672.             End If
  1673.         Case "sc"                           '删除
  1674.             Call Card_Del
  1675.         Case "bc"                           '保存
  1676.             Call Bclrsj
  1677.         Case "fq"                           '放弃
  1678.             If str_State = "1" Then
  1679.                 Call Zdbm
  1680.                 Call Txt_Clear
  1681.                 Call Recordset_Move(1)
  1682.             End If
  1683.             str_State = "3"
  1684.             Me.AutoRedraw = False
  1685.             SetToolState
  1686.         Case "first"                        '首张
  1687.             Call Recordset_Move(1)
  1688.         Case "prev"                         '上张
  1689.             Call Recordset_Move(2)
  1690.         Case "next"                         '下张
  1691.             Call Recordset_Move(3)
  1692.         Case "last"                         '末张
  1693.             Call Recordset_Move(4)
  1694.         Case "fh"                           '退 出
  1695.             Unload Me
  1696.         Case "bz"
  1697.             SendKeys "{F1}"
  1698.     End Select
  1699.      
  1700. End Sub
  1702. Private Sub ydcommand_MouseDown(Index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single)     '按钮提供帮助
  1703.     
  1704.     If LrText(Index).Enabled = False Then
  1705.         Exit Sub
  1706.     End If
  1707.     If Index = 12 Then
  1708.         If Trim(LrText(21).Text) <> "" And Trim(LrText(22).Text) <> "" Then
  1709.             Exit Sub
  1710.         End If
  1711.     End If
  1712.     
  1713.     Call Text_Help(Index)
  1714.     
  1715.     '根据资产类别设置取得资产折旧方法、月折旧率、月折旧额和残值率
  1716.     If Index = 3 Then
  1717.         Call From_Sort
  1718.     End If
  1719.     
  1720.     '根据用户选择的币种，取得汇率
  1721.     Call From_Ccur
  1722.     
  1723. End Sub
  1725. Private Sub Text_Help(Index As Integer)                                                       '录入字段帮助
  1726.     
  1727.     If Not Textboolean(Index, 1) Then
  1728.         Exit Sub
  1729.     End If
  1730.     TextValiJudgeLock(Index) = True
  1731.    
  1732.     '先进行有效性判断
  1733.     If Not TextYxxpd(CurTextIndex) Then
  1734.         Exit Sub
  1735.     End If
  1736.      
  1737.     '[>>调入参照窗体
  1738.     Call Drbmhelp(Textint(Index, 2), Textstr(Index, 4), Trim(LrText(Index).Text))
  1739.      '<<]
  1741.     If Len(Xtfhcs) <> 0 Then
  1742.         If Textint(Index, 3) = 1 Then
  1743.             LrText(Index).Text = Xtfhcsfz
  1744.             LrText(Index).Tag = Xtfhcs
  1745.         Else
  1746.             LrText(Index).Text = Xtfhcs
  1747.             LrText(Index).Tag = Xtfhcsfz
  1748.         End If
  1749.     End If
  1750.     TextValiJudgeLock(Index) = False
  1751.     LrText(Index).SetFocus
  1752.     
  1753. End Sub
  1755. Private Sub TextShow(Index As Integer)        '文本框得到焦点,显示相应信息
  1757.     '填写文本框得到焦点,进行相应信息处理程序
  1758.     If Index = 2 Then LrText(Index).MaxLength = 20
  1759.    
  1760. End Sub
  1762. Private Sub Wbkcsh()                          '录入文本框初始化
  1763.   
  1764.     Dim Jsqte As Integer
  1765.   
  1766.     '最大录入文本框索引值
  1767.     Max_Text_Index = Textvar(1)
  1768.     
  1769.     ReDim TextValiJudgeLock(Max_Text_Index)
  1770.     For Jsqte = 3 To Max_Text_Index
  1771.         If Len(Trim(Textstr(Jsqte, 1))) <> 0 Then
  1772.             If Textboolean(Jsqte, 1) Then
  1773.                 If Jsqte <> 0 And Not Textboolean(Jsqte, 3) Then
  1774.                     Load ydcommand(Jsqte)
  1775.                 End If
  1776.                 ydcommand(Jsqte).Visible = True
  1777.                 ydcommand(Jsqte).Picture = ydcommand(Jsqte - 1).Picture
  1778.                 ydcommand(Jsqte).Move LrText(Jsqte).Left + LrText(Jsqte).Width, LrText(Jsqte).Top
  1779.             End If
  1780.             TextChangeLock = True
  1781.             LrText(Jsqte).Text = ""
  1782.             LrText(Jsqte).Tag = ""
  1783.             If Textint(Jsqte, 5) <> 0 Then
  1784.                 LrText(Jsqte).MaxLength = Textint(Jsqte, 5)
  1785.             End If
  1786.             TextChangeLock = False
  1787.         End If
  1788.         TextValiJudgeLock(Jsqte) = True
  1789.     Next Jsqte
  1790.             
  1791.     '显示自定义项
  1792.     Call Define
  1793.         
  1794.     '卡片自动编号
  1795.     Call Zdbm
  1796.     
  1797.     '初始化时显示值
  1798.     LrText(14).Text = 1
  1799.     Lbl_Year.Caption = Xtyear                    '会计年度
  1800.     Lbl_Period.Caption = Format(Xtmm, "00")                   '会计期间
  1801.     Lbl_Operator.Caption = Xtczy                 '操作员姓名
  1802.     Com_DeprMethod.Text = Com_DeprMethod.List(0) '资产折旧方法默认值
  1803.     Com_Type.Text = "新增固定资产"               '卡片类型
  1804.     LrText(1).Text = Xtrq
  1805.     LrText(12).Text = XtSCurrName
  1806.     LrText(12).Tag = XtSCurrCode
  1807.     LrText(20).Text = "1"
  1808.     
  1809. End Sub
  1811. Private Function TextYxxpd(Index As Integer) As Boolean           '文本框有效性判断
  1812.     
  1813.     Dim Sqlstr As String
  1814.     Dim Findrec As ADODB.Recordset
  1815.     
  1816.     If TextValiJudgeLock(Index) Then    '文本框内容未曾改变不进行有效性判断
  1817.         TextYxxpd = True
  1818.         Exit Function
  1819.     End If
  1820.     If Trim(LrText(Index)) = "" Then
  1821.         LrText(Index).Tag = ""
  1822.         Call Wbklrwbcl(Index)
  1823.         TextValiJudgeLock(Index) = True
  1824.         TextYxxpd = True
  1825.         Exit Function
  1826.     End If
  1827.     Select Case Textint(Index, 4)
  1828.         Case 1      '编码型
  1829.             Sqlstr = Trim(Textstr(Index, 5))
  1830.             Sqlstr = Replace(Sqlstr, "@", "'" + Trim(LrText(Index).Text) + "'")
  1831.             Set Findrec = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
  1832.             If Findrec.EOF Then
  1833.                 Call Xtxxts(Trim(Textstr(Index, 6)), 0, 1)
  1834.                 LrText(Index).SetFocus
  1835.                 Exit Function
  1836.             Else
  1837.                 Select Case Textint(Index, 3)
  1838.                     Case 0
  1839.                         If Len(Trim(Textstr(Index, 2))) <> 0 Then
  1840.                             LrText(Index).Text = Trim(Findrec.Fields(Trim(Textstr(Index, 2))))
  1841.                         End If
  1842.                         If Len(Trim(Textstr(Index, 3) & "")) <> 0 Then
  1843.                             LrText(Index).Tag = Trim(Findrec.Fields(Trim(Textstr(Index, 3))))
  1844.                         End If
  1845.                     Case 1
  1846.                         If Len(Trim(Textstr(Index, 3) & "")) <> 0 Then
  1847.                             LrText(Index).Text = Trim(Findrec.Fields(Trim(Textstr(Index, 3))))
  1848.                         End If
  1849.                         If Len(Trim(Textstr(Index, 2))) <> 0 Then
  1850.                             LrText(Index).Tag = Trim(Findrec.Fields(Trim(Textstr(Index, 2))))
  1851.                         End If
  1852.                 End Select
  1853.             End If
  1854.         Case 2      '日期型
  1855.             If IsDate(LrText(Index).Text) Then
  1856.                 LrText(Index).Text = Format(LrText(Index).Text, "yyyy-mm-dd")
  1857.                 If Val(Mid(LrText(Index), 1, 4)) < 1900 Then
  1858.                     LrText(Index).Text = "1900" + Mid(LrText(Index), 5, 6)
  1859.                 End If
  1860.             Else
  1861.                 Tsxx = "非法公历日期!(格式:" + Format(Date, "yyyy-mm-dd") + ")"
  1862.                 Call Xtxxts(Tsxx, 0, 1)
  1863.                 LrText(Index).SetFocus
  1864.                 Exit Function
  1865.             End If
  1866.         Case 3      '其他类型
  1867.     End Select
  1868.     TextValiJudgeLock(Index) = True
  1869.     TextYxxpd = True
  1870. End Function