VB开发的ERP系统

            !UseYearsNew = Val(LrText(20).Text)                                         '变动后使用年限
            !FAQuantityOld = Val(LrText(6).Text)                                        '变动前资产总量
            !FAQuantityNew = Val(LrText(7).Text)                                        '变动后资产数量
            !Opreator = Trim(Xt_Czy.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
    End If
Cwcl:
    Cw_DataEnvi.DataConnect.RollbackTrans
    Tsxx = "您的输入有误导致存盘失败，请核对数据！"
    Call Xtxxts(Tsxx, 0, 1)
    Exit Function
    
End Function

'录入有效性判断
Function IsValidity() As Boolean

    IsValidity = False
    
    '变动方式不能为空
    If Trim(Frame1.Caption) = "" Then
        Tsxx = "请先选择变动方式!"
        Call Xtxxts(Tsxx, 0, 4)
        Exit Function
    End If
    
    '变动原因不能为空
    If Trim(LrText(8).Text) = "" Then
        Tsxx = "变动原因不能为空!"
        Call Xtxxts(Tsxx, 0, 4)
        LrText(8).SetFocus
        Exit Function
    End If
    
    '累计折旧不能大于资产原值
    If Val(LrText(14).Text) - Val(LrText(5).Text) > 0 Then
        Tsxx = "累计折旧不能大于资产原值!"
        Call Xtxxts(Tsxx, 0, 4)
        LrText(14).SetFocus
        Exit Function
    End If
        
    '当折旧方法为“工作量法”后，工作总量不能为空
    If Trim(Com_DeprMethod(1).Text) = "工作量法" Then
        If Trim(LrText(16).Text) = "" Then
            Tsxx = "工作总量不能为空!"
            Call Xtxxts(Tsxx, 0, 4)
            LrText(16).SetFocus
            Exit Function
        End If
    End If
    
    IsValidity = True
    
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 Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    Kpgl_CardList.Timer1.Enabled = True
End Sub

Private Sub LrText_Change(Index As Integer)
    
    '屏蔽程序改变控制
    If TextChangeLock Then
        Exit Sub
    End If
   
    TextValiJudgeLock(Index) = False    '打开有效性判断锁
    
    '限制字段录入长度
          
    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

'字段按F2键提供帮助
Private Sub LrText_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)
    
    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 Textint(Index, 9) = 0 Or Textint(Index, 9) = 1 Then '事中判断
        Call TextYxxpd(Index)
    End If
    
End Sub


Private Sub QdCommand_Click()
    Call Save
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 TreeView_NodeClick(ByVal Node As MSComctlLib.Node)
    
    '将变动方式赋值给Frame
    Frame1.Caption = Mid(TreeView.SelectedItem.Text, 8)
    Frame1.Tag = Mid(TreeView.SelectedItem.Text, 2, 5)
    LrText(8).Text = Mid(TreeView.SelectedItem.Text, 8)
    
    If Frame1.Caption <> "" Then
        Call Add_Clock
        Set Rs_Temp = New ADODB.Recordset
        Rs_Temp.Open "select * from Gdzc_VariWbkBj where FAVariCode='" & Trim(Frame1.Tag) & "'", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
        If Not Rs_Temp.EOF Then
            For Jsqte = 0 To LblName.count - 1
                If Trim(Trim(LblName(Jsqte).Tag)) <> "" Then
                    If Rs_Temp.Fields(LblName(Jsqte).Tag) = True Then
                        LrText(Jsqte).Enabled = True
                        LblName(Jsqte).ForeColor = &H80&
                    End If
                End If
            Next Jsqte
            If Rs_Temp.Fields(LblCom(1).Tag) = True Then
                Com_DeprMethod(1).Enabled = True
                LblCom(1).ForeColor = &H80&
            Else
                Com_DeprMethod(1).Enabled = False
                LblCom(1).ForeColor = &H0&
            End If
        End If
        Rs_Temp.Close
        Set Rs_Temp = Nothing
        LrText(0).Enabled = True
        LrText(1).Enabled = True
        LrText(8).Enabled = True
        QdCommand.Enabled = True
    Else
        Call Add_Clock
    End If
    
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
    End If
    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 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