📄 addfixed.frm
字号:
VERSION 5.00
Object = "{86CF1D34-0C5F-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCT2.OCX"
Begin VB.Form AddFixed
Caption = "添加固定资产"
ClientHeight = 6330
ClientLeft = 60
ClientTop = 450
ClientWidth = 7140
LinkTopic = "Form1"
LockControls = -1 'True
ScaleHeight = 6330
ScaleWidth = 7140
StartUpPosition = 3 '窗口缺省
Begin VB.Frame Frame2
Height = 975
Left = 120
TabIndex = 17
Top = 5160
Width = 6855
Begin VB.CommandButton Command2
Caption = "放弃添加"
Height = 615
Left = 3720
TabIndex = 21
Top = 240
Width = 2895
End
Begin VB.CommandButton Command1
Caption = "添加资产"
Default = -1 'True
Height = 615
Left = 240
TabIndex = 20
Top = 240
Width = 2895
End
End
Begin VB.Frame Frame1
Caption = "固定资产添加"
Height = 4935
Left = 120
TabIndex = 0
Top = 120
Width = 6855
Begin VB.TextBox Text7
Appearance = 0 'Flat
Height = 270
Left = 2520
TabIndex = 19
Text = "Text7"
Top = 1440
Width = 1815
End
Begin VB.TextBox Text6
Appearance = 0 'Flat
Height = 1695
Left = 240
MaxLength = 100
TabIndex = 15
Text = "Text6"
Top = 3000
Width = 6375
End
Begin VB.TextBox Text5
Appearance = 0 'Flat
Height = 270
Left = 4800
TabIndex = 13
Text = "Text5"
Top = 1440
Width = 1815
End
Begin MSComCtl2.DTPicker DTPicker1
Height = 255
Left = 2520
TabIndex = 11
Top = 2280
Width = 1815
_ExtentX = 3201
_ExtentY = 450
_Version = 393216
Format = 27000833
CurrentDate = 38012
End
Begin VB.ComboBox PartCombo
Height = 300
Left = 240
TabIndex = 10
Text = "Combo1"
Top = 2280
Width = 1815
End
Begin VB.TextBox Text4
Appearance = 0 'Flat
Height = 270
Left = 240
TabIndex = 7
Text = "Text4"
Top = 1440
Width = 1815
End
Begin VB.TextBox Text3
Appearance = 0 'Flat
Height = 270
Left = 4800
TabIndex = 6
Text = "Text3"
Top = 600
Width = 1815
End
Begin VB.TextBox Text2
Appearance = 0 'Flat
Height = 270
Left = 2520
TabIndex = 4
Text = "Text2"
Top = 600
Width = 1815
End
Begin VB.TextBox Text1
Appearance = 0 'Flat
Height = 270
Left = 240
TabIndex = 1
Text = "Text1"
Top = 600
Width = 1815
End
Begin VB.Label Label9
Caption = "经手人ID"
Height = 255
Left = 2520
TabIndex = 18
Top = 1200
Width = 1335
End
Begin VB.Label Label8
Caption = "资产说明"
Height = 255
Left = 240
TabIndex = 16
Top = 2760
Width = 2055
End
Begin VB.Label Label7
Caption = "联系电话"
Height = 255
Left = 4800
TabIndex = 14
Top = 1200
Width = 1455
End
Begin VB.Label Label6
Caption = "购买日期"
Height = 255
Left = 2520
TabIndex = 12
Top = 2040
Width = 1455
End
Begin VB.Label Label5
Caption = "购买部门"
Height = 255
Left = 240
TabIndex = 9
Top = 2040
Width = 1215
End
Begin VB.Label Label4
Caption = "单价（元）"
Height = 255
Left = 240
TabIndex = 8
Top = 1200
Width = 1335
End
Begin VB.Label Label3
Caption = "资产数目"
Height = 255
Left = 4800
TabIndex = 5
Top = 360
Width = 1335
End
Begin VB.Label Label2
Caption = "资产名称"
Height = 255
Left = 2520
TabIndex = 3
Top = 360
Width = 1575
End
Begin VB.Label Label1
Caption = "资产编号"
Height = 255
Left = 240
TabIndex = 2
Top = 360
Width = 1575
End
End
End
Attribute VB_Name = "AddFixed"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Sub Command1_Click()
Dim sql As String
Dim rs As New ADODB.Recordset
If Text1.Text = "" Then '判断资产编号输入框不为空
MsgBox "资产编号不能为空！", vbCritical
Text1.SetFocus
Exit Sub
End If
If Text2.Text = "" Then '判断资产名称输入框不为空
MsgBox "资产名称不能为空！", vbCritical
Text2.SetFocus
Exit Sub
End If
If Text3.Text = "" Then '判断资产数目输入框不为空
MsgBox "资产数目不能为空！", vbCritical
Text3.SetFocus
Exit Sub
End If
If Text4.Text = "" Then '判断资产单价输入框不为空
MsgBox "资产单价不能为空！", vbCritical
Text4.SetFocus
Exit Sub
End If
If Text7.Text = "" Then '判断经手人ID输入框不为空
MsgBox "经手人ID不能为空！", vbCritical
Text7.SetFocus
Exit Sub
End If
If Text5.Text = "" Then '判断联系电话输入框不为空
MsgBox "联系电话不能为空！", vbCritical
Text5.SetFocus
Exit Sub
End If
If Text6.Text = "" Then '判断资产说明输入框不为空
MsgBox "资产说明不能为空！", vbCritical
Text6.SetFocus
Exit Sub
End If
If Not IsNumeric(Text3.Text) Then '判断资产数目输入框必须是数字
MsgBox "资产数目必须是数字！", vbCritical
Text3.SetFocus
Exit Sub
End If
If Not IsNumeric(Text4.Text) Then '判断资产单价输入框是数字
MsgBox "资产单价必须是数字！", vbCritical
Text4.SetFocus
Exit Sub
End If
If PartCombo.ListIndex = -1 Then '确保部门被选择
MsgBox "部门必须选择！", vbCritical
PartCombo.SetFocus
Exit Sub
End If
If DbHandle.DbConnection Then '打开数据库连接准备添加固定资产记录
sql = "TBL_FIXED" '在固定资产表中搜索,判断是否已经存在和欲添加固定
rs.CursorType = adOpenDynamic '资产具有相同编号的记录
rs.LockType = adLockOptimistic
rs.Filter = "FIXED_ID='" & Text1.Text & "'"
rs.Open sql, DbFinance
If DbHandle.resultcount(rs) = 1 Then '如果找到编号已经存在就提示错误信息,并且退出
MsgBox "资产编号已经存在！", vbExclamation
rs.Close
DbHandle.DbClose
Exit Sub
End If
rs.Close
sql = "TBL_USER" '在职工表中判断输入的职工ID是否是有效ID
rs.CursorType = adOpenDynamic
rs.LockType = adLockOptimistic
rs.Filter = "USER_ID='" & Text7.Text & "'"
rs.Open sql, DbFinance
If DbHandle.resultcount(rs) <> 1 Then '不存在输入的职工ID就提示错误信息退出
MsgBox "错误，不存在的ID号！", vbExclamation
Text7.SetFocus
rs.Close
Set rs = Nothing
DbHandle.DbClose
Exit Sub
Else '职工ID是有效的,可以进行添加固定资产
rs.Close
sql = "TBL_FIXED"
rs.Filter = ""
rs.Open sql, DbFinance
rs.AddNew
rs("FIXED_ID") = Text1.Text '固定资产编号
rs("FIXED_NAME") = Text2.Text '固定资产名称
rs("FIXED_NUM") = Val(Text3.Text) '固定资产数目
rs("FIXED_MONEY") = Val(Text4.Text) '固定资产单价
rs("FIXED_PART") = PartCombo.ItemData(PartCombo.ListIndex) '购买固定资产部门
rs("FIXED_USER") = Text7.Text '经手人ID
rs("FIXED_PHONE") = Text5.Text '经手人电话
rs("FIXED_DATE") = DTPicker1.Value '购买时间
rs("FIXED_REMARK") = Text6.Text '固定资产说明
rs.Update
rs.Close
End If
DbHandle.DbClose
MsgBox "固定资产信息成功添加！"
Unload Me
Else '打开数据库连接失败提示出错
MsgBox "数据库错误！", vbExclamation
DbHandle.DbClose
End
End If
End Sub
Private Sub Command2_Click()
Unload Me '取消并回主窗体
End Sub
Private Sub Form_Load()
Dim sql As String
Dim rs As New ADODB.Recordset
Me.Left = (Screen.Width - Me.ScaleWidth) / 2 '窗体居中显示
Me.Top = (Screen.Height - Me.ScaleHeight) / 2
If DbHandle.DbConnection Then '打开数据库连接,动态添加部门信息下拉列表
sql = "TBL_PART"
rs.CursorType = adOpenDynamic
rs.LockType = adLockOptimistic
rs.Filter = ""
rs.Open sql, DbFinance
Do While rs.EOF = False
PartCombo.AddItem (rs("PART_NAME"))
PartCombo.ItemData(PartCombo.NewIndex) = rs("PART_ID")
rs.MoveNext
Loop
rs.Close '完成下拉列表的动态添加,释放结果集资源,关闭数据库连接
Set rs = Nothing
DbHandle.DbClose
Else '打开数据库连接失败提示出错
MsgBox "数据库错误！", vbExclamation
DbHandle.DbClose
End
End If
Text1.Text = "" '初始化窗体元素属性
Text2.Text = ""
Text3.Text = ""
Text4.Text = ""
Text5.Text = ""
Text6.Text = ""
Text7.Text = ""
Text7.MaxLength = 100
PartCombo.Text = ""
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -