VB开发的ERP系统

      BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628} 
         NumListImages   =   4
         BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "资产减少.frx":1B00
            Key             =   "T"
         EndProperty
         BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "资产减少.frx":23DA
            Key             =   "C"
         EndProperty
         BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "资产减少.frx":2CB4
            Key             =   "Cl"
         EndProperty
         BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "资产减少.frx":3D06
            Key             =   "O"
         EndProperty
      EndProperty
   End
End
Attribute VB_Name = "FAVari_Lessen"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'*******************************************************
'*    模 块 名 称 :资产减少
'*    功 能 描 述 :资产减少
'*    程序员姓名  :徐衍民
'*    最后修改人  :徐衍民
'*    最后修改时间:2001/12/4
'*    备        注:自定义模块
'*******************************************************
Dim Tsxx As String                       '系统信息提示
Dim Rs_Temp As ADODB.Recordset           '数据集变量
Dim Sqlstr As String                     '字符串变量
Dim Activities As String                 '工作总量
Dim MaxCode As String                    '最大变动单据号变量

'以下为固定使用变量(文本框)
Dim Textvar() As Variant                 '存储变体型文本框信息
Dim Textboolean() As Boolean             '存储布尔型文本框信息
Dim Textint() As Integer                 '存储整型文本框信息
Dim Textstr() As String                  '存储字符型文本框信息
Dim Max_Text_Index As Integer            '最大录入文本框索引值
Dim TextGroupCode As String              '文本框录入分组编码
Dim TextValiLock As Boolean              '文本框失去焦点是否进行有效性控制判断
Dim TextValiJudgeLock() As Boolean       '文本框录入有效性判断控制锁
Dim CurTextIndex As Integer              '当前文本框索引值
Dim TextChangeLock As Boolean            '文本框内容变换控制锁
Dim Bln_Cancel As Boolean                '取消按钮信息传递

Private Sub Form_Activate()              '赋值给各文本框
    Call Card_Edit
End Sub

Private Sub Form_KeyPress(KeyAscii As Integer)   '控 制 焦 点 转 移
    
    Dim jdzygs As Integer                         '控件焦点转移个数
    jdzygs = 30
    Select Case KeyAscii
        Case vbKeyReturn
            If Kjjdzy(jdzygs) Then
                KeyAscii = 0
            End If
        Case 39           '屏蔽"'"
            KeyAscii = 0
    End Select

End Sub

Private Sub Form_Load()
   
    '以下为文本框处理程序
    TextGroupCode = "Gdzc_lessen"
    Call Drwbkxx(TextGroupCode, Textvar(), Textboolean(), Textint(), Textstr())  '读入文本框录入信息
    Call Wbkcsh
    
    '显示资产减少方式
    Call VariationMode

    '赋初值
    Lbl_Year.Caption = Xtyear                        '会计年度
    Lbl_Period.Caption = Format(Xtmm, "00")          '会计期间
    Lbl_Operator.Caption = Xtczy                     '系统操作员
    
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    Kpgl_CardList.Timer1.Enabled = True
End Sub

'单击减少方式，激活文本框编辑状态
Private Sub Lst_Sort_Click()
    
    Dim i As Integer
    
    Frame1.Caption = RightChar(Lst_Sort.List(Lst_Sort.ListIndex))
    Frame1.Tag = LeftChar(Lst_Sort.List(Lst_Sort.ListIndex))
    
    For i = 14 To 18
        LrText(i).Enabled = True
    Next i
    LrText(14).SetFocus
    QdCommand.Enabled = True
    
End Sub

Private Sub QdCommand_Click()                                   '确 定
    Call Save
End Sub

Private Function Lrtjyxxpd() As Boolean                          '用户录入条件有效性判断
 
    Dim Jsqte As Integer
    Lrtjyxxpd = False
 
    '对需要进行事后判断的文本框录入内容进行有效性判断 (固定不变)
    For Jsqte = 0 To Max_Text_Index
        If Textint(Jsqte, 9) = 0 Or Textint(Jsqte, 9) = 2 Then
            If Not TextYxxpd(Jsqte) Then
                Exit Function
            End If
        End If
    Next Jsqte
   
    '[>>以下为依据实际情况自定义部分
 
    '<<]以上为依据实际情况自定义部分
 
    Lrtjyxxpd = True

End Function

'*******************以下区域为编写自定义过程区域**********************
'显示资产减少方式函数
Function VariationMode()

    Set Rs_Temp = New ADODB.Recordset
    Rs_Temp.Open "select * from Gdzc_VariationMode where VariSort=2", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
    While Not Rs_Temp.EOF
        Lst_Sort.AddItem "(" & Trim(Rs_Temp!FAVariCode) & ")" & Rs_Temp!FAVariName
        Rs_Temp.MoveNext
    Wend
    Rs_Temp.Close
    Set Rs_Temp = Nothing

End Function

'取左字符串函数
Private Function LeftChar(str As String) As String
    
    Dim i As Integer
    i = Len(str)
    LeftChar = Mid(str, 2, InStr(str, ")") - 2)

End Function

'取右字符串函数
Private Function RightChar(str As String) As String
    
    Dim i As Integer
    i = Len(str)
    RightChar = Mid(str, InStr(str, ")") + 1)

End Function

'为文本框赋初值
Function Card_Edit()
        
    Set Rs_Temp = New ADODB.Recordset
    Sqlstr = "SELECT Gdzc_Card.*, Gdzc_State.FAStateName AS FAStateName," _
        & "Gdzc_Sort.FASortName AS FASortName,Gy_Department.DeptName AS DeptName " _
        & "FROM Gdzc_Card LEFT OUTER JOIN Gdzc_State ON Gdzc_Card.FAStateCode = Gdzc_State.FaStateCode LEFT OUTER JOIN " _
        & "Gy_Department ON Gdzc_Card.DeptCode = Gy_Department.DeptCode LEFT OUTER JOIN " _
        & "Gdzc_Sort ON Gdzc_Card.FASortCode = Gdzc_Sort.FASortCode"
    Sqlstr = Sqlstr & " where cardCode='" & Trim(Lbl_Num.Caption) & "'"
    Rs_Temp.Open Sqlstr, Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
    With Rs_Temp
        If Not .EOF Then
            Activities = !Activities                '工作总量
            LrText(0).Text = !FAName                '资产名称
            LrText(1).Text = !DeptName              '部门名称
            LrText(1).Tag = !DeptCode               '部门编号
            LrText(2).Text = !FAStateName           '使用状况名称
            LrText(2).Tag = !FAStateCode            '使用状况编号
            LrText(3).Text = !FASortName            '资产类别名称
            LrText(3).Tag = !FASortCode             '资产类别编号
            Select Case !DeprMethod                 '折旧方法
                Case "01"
                    LrText(4).Text = "不计提折旧"
                    LrText(4).Tag = "01"
                Case "02"
                    LrText(4).Text = "平均年限法(依净资产计提折旧)"
                    LrText(4).Tag = "02"
                Case "03"
                    LrText(4).Text = "平均年限法(依帐面原值计提折旧)"
                    LrText(4).Tag = "03"
                Case "04"
                    LrText(4).Text = "工作量法"
                    LrText(4).Tag = "04"
                Case "05"
                    LrText(4).Text = "固定折旧额折旧法"
                    LrText(4).Tag = "05"
                Case "06"
                    LrText(4).Text = "年数总和法"
                    LrText(4).Tag = "06"
                Case "07"
                    LrText(4).Text = "双倍余额法"
                    LrText(4).Tag = "07"
            End Select
            LrText(5).Text = !Useyears              '使用年限
            LrText(6).Text = !DeprSum               '累计折旧
            LrText(7).Text = !DeprSum               '累计折旧
            LrText(8).Text = !FAValue               '资产原值
            LrText(9).Text = !FAValue               '资产原值
            LrText(10).Text = !FAQuantity           '资产数量
            LrText(11).Text = !FAQuantity           '资产数量
            LrText(12).Text = !SalValue             '净残值
            LrText(13).Text = !SalValue             '净残值
        End If
    End With
    Rs_Temp.Close
    Set Rs_Temp = Nothing

End Function

'资产减少存盘
Function Save()
    
    '录入有效性判断
    If Judge = False Then Exit Function
    
    On Error GoTo Cwcl
    Cw_DataEnvi.DataConnect.BeginTrans
    
    '修改资产卡片表
    Set Rs_Temp = New ADODB.Recordset
    Rs_Temp.Open "select * from Gdzc_Card where CardCode='" & Trim(Lbl_Num.Caption) & "'", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
    With Rs_Temp
        If Not .EOF Then
            !FAValue = CCur(Val(LrText(9).Text))            '资产原值
            !DeprSum = CCur(Val(LrText(7).Text))            '累计折旧
            !FAQuantity = Val(LrText(11).Text)              '资产数量
            !FactValue = Val(!FAValue) - Val(!DeprSum)      '净资产
            !SalValue = CCur(LrText(12).Text)               '净残值
            .Update
        End If
    End With
    Rs_Temp.Close
    Set Rs_Temp = Nothing
    
    '修改会计资产明细表
    Set Rs_Temp = New ADODB.Recordset
    Rs_Temp.Open "select * from Gdzc_DetailedForm where cardCode='" & Trim(Lbl_Num.Caption) & "' and FASortCode='" & Trim(LrText(3).Tag) & "' and year=" & Xtyear & " and period=" & Xtmm, Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
    With Rs_Temp
        If Not .EOF Then
            !FAValueEnd = CCur(Val(!FAValueEnd) + Val(LrText(8).Text) - Val(LrText(9).Text))    '期末原值
            !DeprSumEnd = CCur(Val(!DeprSumEnd) + Val(LrText(7).Text) - Val(LrText(6).Text))    '期末累计折旧
            .Update
        Else
            .AddNew
            !CardCode = Trim(Lbl_Num.Caption)               '卡片编号
            !FASortCode = Trim(LrText(3).Tag)               '资产类别编号
            !Year = Xtyear                                  '会计年度
            !Period = Val(Xtmm)                             '会计期间
            !MmMake = False                                 '录入期间标志
            !FAValueEnd = CCur(Val(LrText(8).Text))         '期末原值
            !DeprSumEnd = CCur(LrText(7).Text)              '期末累计折旧
            .Update
        End If
    End With
    Rs_Temp.Close
    Set Rs_Temp = Nothing
    
    '修改资产汇总表
    Set Rs_Temp = New ADODB.Recordset
    Rs_Temp.Open "select * from Gdzc_total where DeptCode='" & Trim(LrText(1).Tag) & "' and FASortCode='" & Trim(LrText(3).Tag) & "' and year=" & Xtyear & " and Period=" & Xtmm, Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
    With Rs_Temp
        If Not .EOF Then
            !FAvalueEndM = CCur(Val(!FAvalueEndM) - Val(LrText(9).Text) + Val(LrText(8).Text))  '期末资产原值
            !DeprSumEndM = CCur(Val(!DeprSumEndM) - Val(LrText(6).Text) + Val(LrText(7).Text))  '期末累计折旧
            !FAValueOutM = CCur(Val(LrText(8).Text) - Val(LrText(9).Text))                      '本期原值减少
            !DeprSumInM = CCur(Abs(Val(LrText(6).Text) - Val(LrText(7).Text)))                  '本期累计折旧增加
            .Update
        Else
            .AddNew
            !DeptCode = Trim(LrText(1).Tag)                                                     '所属部门
            !FASortCode = Trim(LrText(3).Tag)                                                   '资产类别
            !Year = Xtyear                                                                      '会计年度
            !Period = Xtmm                                                                      '会计期间
            !FAvalueEndM = CCur(Val(!FAvalueEndM) - Val(LrText(9).Text) + Val(LrText(8).Text))  '期末资产原值
            !DeprSumEndM = CCur(Val(!DeprSumEndM) - Val(LrText(6).Text) + Val(LrText(7).Text))  '期末累计折旧
            !FAValueOutM = CCur(Val(LrText(8).Text) - Val(LrText(9).Text))                      '本期原值减少
            !DeprSumInM = CCur(Abs(Val(LrText(6).Text) - Val(LrText(7).Text)))                  '本期累计折旧增加
            .Update
        End If
    End With
    Rs_Temp.Close
    Set Rs_Temp = Nothing
    
    '增加资产变动单
    Call Vari         '取得变动单据号
    Set Rs_Temp = New ADODB.Recordset
    Rs_Temp.Open "select * from gdzc_variation", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
    With Rs_Temp
        .AddNew
        !VariVouCode = MaxCode                          '变动单据号
        !CardCode = Trim(Lbl_Num.Caption)               '卡片编号
        !Year = Val(Trim(Lbl_Year.Caption))             '会计年度
        !Period = Val(Trim(Lbl_Period.Caption))         '会计期间
        !varidate = Xtrq                                '变动日期
        !FAVariCode = Trim(Frame1.Tag)                  '变动方式
        If Trim(LrText(16).Text) <> "" Then !VouchClassCode = Trim(LrText(16).Tag)                      '凭证类型
        If Trim(LrText(17).Text) <> "" Then !VouchNo = Val(LrText(17).Text)                             '凭证号
        !VariationReason = Trim(LrText(18).Text) & Space(2) & "清理收入:￥" & Format(Val(LrText(15).Text), "###,##0.00")   '变动原因
        !DeptOld = Trim(LrText(1).Tag)                  '变动前所属部门
        !DeptNew = Trim(LrText(1).Tag)                  '变动后所属部门