VB开发的ERP系统

        !FAStateOld = Trim(LrText(2).Tag)               '变动前使用状况
        !FAStateNew = Trim(LrText(2).Tag)               '变动后使用状况
        !DeprMethOld = Trim(LrText(4).Tag)
        !DeprMethNew = Trim(LrText(4).Tag)              '折旧方法
        !FASortOld = Trim(LrText(3).Tag)
        !FASortNew = Trim(LrText(3).Tag)                '资产类别
        !FAValueOld = CCur(Val(LrText(8).Text))
        !FAValueNew = CCur(Val(LrText(9).Text))         '资产原值
        !SumDeprOld = CCur(Val(LrText(6).Text))
        !SumDeprNew = CCur(Val(LrText(7).Text))         '累计折旧
        !ActivitiesOld = Activities
        !ActivitiesNew = Activities                     '工作总量
        !SalValueOld = CCur(Val(LrText(12).Text))
        !SalValueNew = CCur(Val(LrText(13).Text))       '净残值
        !UseYearsOld = Val(LrText(5).Text)
        !UseYearsNew = Val(LrText(5).Text)              '使用年限
        !FAQuantityOld = Val(LrText(10).Text)
        !FAQuantityNew = Val(LrText(11).Text)           '资产数量
        !Opreator = Trim(Lbl_Operator.Caption)          '操作员
        .Update
    End With
    Rs_Temp.Close
    Set Rs_Temp = Nothing
           
    Cw_DataEnvi.DataConnect.CommitTrans
    MsgBox "资产减少变动单生成完毕!变动单号--" + Trim(MaxCode), vbOKOnly + vbInformation, "百利/ERP5.0-固定资产"
    Unload Me
    Exit Function
Cwcl:
    Cw_DataEnvi.DataConnect.RollbackTrans
    Tsxx = "存盘失败，请核对数据!"
    Call Xtxxts(Tsxx, 0, 1)
    Exit Function

End Function

'录入判断
Function Judge() As Boolean
    
    Judge = False
    
    '资产减少数量不能大于原有资产数量
    If Val(LrText(14).Text) > Val(LrText(10).Text) Then
        Tsxx = "资产减少数量不能大于原有资产数量!"
        Call Xtxxts(Tsxx, 0, 4)
        LrText(14).Text = ""
        LrText(14).SetFocus
        Exit Function
    End If
    
    '减少原因不能为空
    If LrText(18).Text = "" Then
        Tsxx = "减少原因不能为空!"
        Call Xtxxts(Tsxx, 0, 4)
        LrText(18).SetFocus
        Exit Function
    End If
    
    Judge = True
    
End Function

'资产折旧后剩余的各数据值
Function Depr()
    
    LrText(7).Text = Format(Val(LrText(6).Text) - Val(LrText(6).Text / Val(LrText(10).Text) * Val(LrText(14).Text)), "##0.00")       '剩余累计折旧
    LrText(9).Text = Format(Val(LrText(8).Text) - Val(LrText(8).Text / Val(LrText(10).Text) * Val(LrText(14).Text)), "##0.00")    '剩余剩余资产原值
    LrText(13).Text = Format(Val(LrText(12).Text) / Val(LrText(10).Text) * Val(Val(LrText(10).Text) - Val(LrText(14).Text)), "##0.00")       '剩余净残值

End Function

'变动单自动编号
Function Vari()
    
    Dim Max_Code As Double                              '最大值数值变量
    
    Set rstemp = New ADODB.Recordset
    rstemp.Open "select max(VariVouCode) as Max_CardCode from Gdzc_Variation", Cw_DataEnvi.DataConnect, adOpenKeyset, adLockOptimistic
    If Val(rstemp.Fields("Max_CardCode") & "") = 0 Then
        Max_Code = 1
    Else
        Max_Code = Val(rstemp.Fields("Max_CardCode")) + 1
    End If
    rstemp.Close
    Set rstemp = Nothing
    
    MaxCode = IIf(Max_Code < 10, "00000" & Max_Code, IIf(Max_Code < 100, "0000" & Max_Code, IIf(Max_Code < 1000, "000" & Max_Code, IIf(Max_Code < 10000, "00" & Max_Code, IIf(Max_Code < 100000, "0" & Max_Code, Max_Code)))))

End Function
'*******************以上区域为编写自定义过程区域**********************

'************以下为文本框录入处理程序(固定不变部分)*************'
Private Sub Wbklrwbcl(Index As Integer)    '文本框录入事后处理程序

    '以下为依据实际情况自定义部分[
  
    '在此填写文本框录入事后处理程序
   
    ']以上为依据实际情况自定义部分

End Sub

Private Sub LrText_Change(Index As Integer)

    '屏蔽程序改变控制
    If TextChangeLock Then
        Exit Sub
    End If
   
    TextValiJudgeLock(Index) = False    '打开有效性判断锁
    
    '取得资产减少后的资产数量
    LrText(11).Text = Val(LrText(10).Text) - Val(LrText(14).Text)
    
    '限制字段录入长度
    TextChangeLock = True  '加锁(防止执行Lrtext_Change)
    Select Case Textint(Index, 1)
        Case 8, 11      '金额型
            Call Sjgskz(LrText(Index), Xtjezws - Xtjexsws - 1, Xtjexsws)
        Case 9, 12      '数量型
            Call Sjgskz(LrText(Index), Xtslzws - Xtslxsws - 1, Xtslxsws)
        Case 10          '单价型
            Call Sjgskz(LrText(Index), Xtdjzws - Xtdjxsws - 1, Xtdjxsws)
        Case Else        '其他小数类型控制
            If Textint(Index, 6) <> 0 Or Textint(Index, 7) <> 0 Then
                Call Sjgskz(LrText(Index), Textint(Index, 6), Textint(Index, 7))
            End If
        End Select
    TextChangeLock = False '解锁

End Sub

Private Sub LrText_GotFocus(Index As Integer)                                                 '文本框得到焦点,显示相应信息
    
    Call TextShow(Index)
    CurTextIndex = Index
    LrText(Index).SelStart = Len(LrText(Index))

End Sub

Private Sub LrText_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)            '字段按F2键提供帮助
    
    Select Case KeyCode
        Case vbKeyF2
            Call Text_Help(Index)
    End Select

End Sub

Private Sub LrText_KeyPress(Index As Integer, KeyAscii As Integer)                            '文本框录入事中控制
    Call InputFieldLimit(LrText(Index), Textint(Index, 1), KeyAscii)
End Sub

Private Sub LrText_LostFocus(Index As Integer)                                                '文本框失去焦点进行有效性判断及相应处理
    
    If Index = 14 Then Call Depr
    
    If Textint(Index, 9) = 0 Or Textint(Index, 9) = 1 Then '事中判断
        Call TextYxxpd(Index)
    End If

End Sub

Private Sub SzToolbar_ButtonClick(ByVal Button As MSComctlLib.Button)
    
    Select Case Button.Key
        Case "bz"
            SendKeys "{F1}"
        Case "fh"
            Unload Me
    End Select

End Sub

Private Sub ydcommand_MouseDown(Index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single)     '按钮提供帮助
    
    If LrText(Index).Enabled = False Then Exit Sub
    Call Text_Help(Index)

End Sub

Private Sub Text_Help(Index As Integer)                                                       '录入字段帮助
    
    If Not Textboolean(Index, 1) Then
        Exit Sub
    End If
    TextValiJudgeLock(Index) = True
   
    '先进行有效性判断
    If Not TextYxxpd(CurTextIndex) Then
        Exit Sub
    End If
     
    '[>>调入参照窗体
    Call Drbmhelp(Textint(Index, 2), Textstr(Index, 4), Trim(LrText(Index).Text))
     '<<]

    If Len(Xtfhcs) <> 0 Then
        If Textint(Index, 3) = 1 Then
            LrText(Index).Text = Xtfhcsfz
            LrText(Index).Tag = Xtfhcs
        Else
            LrText(Index).Text = Xtfhcs
            LrText(Index).Tag = Xtfhcsfz
        End If
    End If
    TextValiJudgeLock(Index) = False
    LrText(Index).SetFocus

End Sub

Private Sub TextShow(Index As Integer)        '文本框得到焦点,显示相应信息

    '填写文本框得到焦点,进行相应信息处理程序
   
End Sub

Private Sub Wbkcsh()                          '录入文本框初始化
  
    Dim Jsqte As Integer
  
    '最大录入文本框索引值
    Max_Text_Index = Textvar(1)
  
    ReDim TextValiJudgeLock(Max_Text_Index)
    
    For Jsqte = 0 To Max_Text_Index
        LrText(Jsqte).Text = ""
    Next Jsqte

    For Jsqte = 0 To Max_Text_Index
        If Len(Trim(Textstr(Jsqte, 1))) <> 0 Then
            If Textboolean(Jsqte, 1) Then
                If Jsqte <> 0 And Not Textboolean(Jsqte, 3) Then
                    Load ydcommand(Jsqte)
                End If
                ydcommand(Jsqte).Visible = True
                ydcommand(Jsqte).Move LrText(Jsqte).Left + LrText(Jsqte).Width, LrText(Jsqte).Top
            End If
            TextChangeLock = True
            LrText(Jsqte).Text = ""
            LrText(Jsqte).Tag = ""
            If Textint(Jsqte, 5) <> 0 Then
                LrText(Jsqte).MaxLength = Textint(Jsqte, 5)
            End If
            TextChangeLock = False
        End If
        TextValiJudgeLock(Jsqte) = True
    Next Jsqte

End Sub

Private Function TextYxxpd(Index As Integer) As Boolean           '文本框有效性判断
    
    Dim Sqlstr As String
    Dim Findrec As ADODB.Recordset
    
    If TextValiJudgeLock(Index) Then    '文本框内容未曾改变不进行有效性判断
        TextYxxpd = True
        Exit Function
    End If
    
    If Trim(LrText(Index)) = "" Then
        LrText(Index).Tag = ""
        Call Wbklrwbcl(Index)
        TextValiJudgeLock(Index) = True
        TextYxxpd = True
        Exit Function
    End If
    
    Select Case Textint(Index, 4)
        Case 1      '编码型
            Sqlstr = Trim(Textstr(Index, 5))
            Sqlstr = Replace(Sqlstr, "@", "'" + Trim(LrText(Index).Text) + "'")
            Set Findrec = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
            If Findrec.EOF Then
                Call Xtxxts(Trim(Textstr(Index, 6)), 0, 1)
                LrText(Index).SetFocus
                Exit Function
            Else
                Select Case Textint(Index, 3)
                    Case 0
                        If Len(Trim(Textstr(Index, 2))) <> 0 Then
                            LrText(Index).Text = Trim(Findrec.Fields(Trim(Textstr(Index, 2))))
                        End If
                        If Len(Trim(Textstr(Index, 3) & "")) <> 0 Then
                            LrText(Index).Tag = Trim(Findrec.Fields(Trim(Textstr(Index, 3))))
                        End If
                    Case 1
                        If Len(Trim(Textstr(Index, 3) & "")) <> 0 Then
                            LrText(Index).Text = Trim(Findrec.Fields(Trim(Textstr(Index, 3))))
                        End If
                        If Len(Trim(Textstr(Index, 2))) <> 0 Then
                            LrText(Index).Tag = Trim(Findrec.Fields(Trim(Textstr(Index, 2))))
                        End If
                End Select
            End If
        Case 2      '日期型
            If IsDate(LrText(Index).Text) Then
                LrText(Index).Text = Format(LrText(Index).Text, "yyyy-mm-dd")
                If Val(Mid(LrText(Index), 1, 4)) < 1900 Then
                    LrText(Index).Text = "1900" + Mid(LrText(Index), 5, 6)
                End If
            Else
                Tsxx = "非法公历日期!(格式:" + Format(Date, "yyyy-mm-dd") + ")"
                Call Xtxxts(Tsxx, 0, 1)
                LrText(Index).SetFocus
                Exit Function
            End If
        Case 3      '其他类型
        
    End Select
    TextValiJudgeLock(Index) = True
    TextYxxpd = True

End Function