📄 员工信息管理.frm
字号:
VERSION 5.00
Begin VB.Form StuffManage
BorderStyle = 1 'Fixed Single
Caption = "员工信息管理"
ClientHeight = 3660
ClientLeft = 45
ClientTop = 435
ClientWidth = 7485
LinkTopic = "Form1"
MaxButton = 0 'False
MDIChild = -1 'True
MinButton = 0 'False
ScaleHeight = 3660
ScaleWidth = 7485
Begin VB.PictureBox picNavigation
Height = 375
Left = 480
ScaleHeight = 315
ScaleWidth = 5115
TabIndex = 21
Top = 2520
Width = 5175
Begin VB.TextBox txtNews
Height = 375
Left = 840
TabIndex = 26
Top = 0
Width = 3375
End
Begin VB.CommandButton cmdMove
Caption = ">|"
Height = 375
Index = 3
Left = 4560
TabIndex = 25
Top = 0
Width = 375
End
Begin VB.CommandButton cmdMove
Caption = ">"
Height = 375
Index = 2
Left = 4200
TabIndex = 24
Top = 0
Width = 375
End
Begin VB.CommandButton cmdMove
Caption = "<"
Height = 375
Index = 1
Left = 480
TabIndex = 23
Top = 0
Width = 375
End
Begin VB.CommandButton cmdMove
Caption = "|<"
Height = 375
Index = 0
Left = 120
TabIndex = 22
Top = 0
Width = 375
End
End
Begin VB.CommandButton cmdExit
Caption = "关闭"
Height = 375
Left = 6120
TabIndex = 13
Top = 2640
Width = 975
End
Begin VB.CommandButton cmdSave
Caption = "保存"
Height = 375
Left = 6120
TabIndex = 12
Top = 2040
Width = 975
End
Begin VB.ComboBox cmbTitle
Height = 300
ItemData = "员工信息管理.frx":0000
Left = 4080
List = "员工信息管理.frx":0013
Style = 2 'Dropdown List
TabIndex = 11
Top = 1320
Width = 1215
End
Begin VB.ComboBox cmbDuty
Height = 300
ItemData = "员工信息管理.frx":0035
Left = 4080
List = "员工信息管理.frx":0048
Style = 2 'Dropdown List
TabIndex = 10
Top = 877
Width = 1215
End
Begin VB.CheckBox chkExpert
Caption = "专家"
Height = 375
Left = 4080
TabIndex = 9
Top = 1920
Width = 855
End
Begin VB.CheckBox chkHouse
Caption = "有住房"
Height = 375
Left = 2925
TabIndex = 8
Top = 1920
Width = 975
End
Begin VB.CommandButton cmdRefresh
Caption = "刷新"
Height = 375
Left = 6120
TabIndex = 7
Top = 1440
Width = 975
End
Begin VB.CommandButton cmdDelete
Caption = "删除"
Height = 375
Left = 6120
TabIndex = 6
Top = 840
Width = 975
End
Begin VB.CommandButton cmdAdd
Caption = "添加"
Height = 375
Left = 6120
TabIndex = 5
Top = 240
Width = 975
End
Begin VB.TextBox txtNum
Height = 375
Left = 4080
TabIndex = 4
Top = 360
Width = 1215
End
Begin VB.TextBox txtTime
Height = 375
Left = 1440
TabIndex = 3
Top = 1800
Width = 1215
End
Begin VB.TextBox txtBirth
Height = 375
Left = 1440
TabIndex = 2
Top = 1320
Width = 1215
End
Begin VB.TextBox txtDept
Height = 375
Left = 1440
TabIndex = 1
Top = 840
Width = 1215
End
Begin VB.TextBox txtUser
Height = 375
Left = 1440
TabIndex = 0
Top = 360
Width = 1215
End
Begin VB.Label Label7
AutoSize = -1 'True
Caption = "职称："
Height = 180
Left = 3360
TabIndex = 20
Top = 1440
Width = 540
End
Begin VB.Label Label6
AutoSize = -1 'True
Caption = "职务："
Height = 180
Left = 3360
TabIndex = 19
Top = 960
Width = 540
End
Begin VB.Label Label5
AutoSize = -1 'True
Caption = "员工编号："
Height = 180
Left = 3000
TabIndex = 18
Top = 480
Width = 900
End
Begin VB.Label Label4
AutoSize = -1 'True
Caption = "工作时间："
Height = 180
Left = 360
TabIndex = 17
Top = 1920
Width = 900
End
Begin VB.Label Label3
AutoSize = -1 'True
Caption = "出生日期："
Height = 180
Left = 360
TabIndex = 16
Top = 1440
Width = 900
End
Begin VB.Label Label2
AutoSize = -1 'True
Caption = "所属部门："
Height = 180
Left = 360
TabIndex = 15
Top = 960
Width = 900
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "员工姓名："
Height = 180
Left = 360
TabIndex = 14
Top = 480
Width = 900
End
End
Attribute VB_Name = "StuffManage"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'创建"员工信息管理"窗体-----包括对员工用于计算工资的基本信息进行添加,修改,删除等操
Dim isAdding As Boolean 'isAdding用于标识是否处于添加记录状态
Dim objCn As Connection, objRs As Recordset
'objCn用于建立数据库连接 'objRs用于保存"员工数据"表数据
Private Sub cmdAdd_Click()
txtUser = ""
txtDept = ""
txtBirth = ""
txtTime = ""
txtNum = ""
cmbDuty.ListIndex = 4
cmbTitle.ListIndex = 4
chkHouse = 0
chkExpert = 0
txtNews = "添加新记录"
isAdding = True
cmdAdd.Enabled = False
cmdDelete.Enabled = False
picNavigation.Enabled = False
End Sub
Private Sub cmdDelete_Click()
On Error GoTo DealError
With objRs
If Not .EOF Then
If MsgBox("将删除<" & Trim(txtUser) & ">的用户数据，是否继续？", vbCritical + vbYesNo, "员工信息管理") = vbYes Then
.Delete
.MoveNext
If .EOF And .RecordCount > 0 Then .MoveLast
ShowCurrentRecord
End If
End If
End With
Exit Sub
DealError:
msg = "程序执行出错，错误信息如下：" & vbCrLf & Err.Description
ShowError msg
End Sub
Private Sub cmdExit_Click()
Unload Me
End Sub
Private Sub cmdMove_Click(Index As Integer)
On Error GoTo DealError
With objRs
Select Case Index '切换当前记录
Case 0 '使第一个记录为当前记录
If .RecordCount > 0 And Not .BOF Then .MoveFirst
Case 1 '使上一个记录为当前记录
If .RecordCount > 0 And Not .BOF Then
.MovePrevious
If .BOF Then .MoveFirst
End If
Case 2 '使下一个记录为当前记录
If .RecordCount > 0 And Not .EOF Then
.MoveNext
If .EOF Then .MoveLast
End If
Case 3
If .RecordCount > 0 And Not .EOF Then .MoveLast
End Select
ShowCurrentRecord
End With
Exit Sub
DealError:
msg = "程序执行出错，错误信息如下：" & vbCrLf & Err.Description
ShowError msg
End Sub
Private Sub cmdRefresh_Click()
objRs.Requery
ShowCurrentRecord
cmdAdd.Enabled = True
cmdDelete.Enabled = True
isAdding = False
picNavigation.Enabled = True
End Sub
Private Sub cmdSave_Click()
On Error GoTo DealError
If Trim(txtUser) = "" Then
MsgBox "用户名不能为空!", vbCritical, "员工信息管理"
txtUser.SetFocus
ElseIf Not IsDate(txtBirth) Then
MsgBox "无效的出生日期!", vbCritical, "员工信息管理"
txtBirth.SetFocus
ElseIf Trim(txtNum) = "" Then
MsgBox "员工编号不能为空!", vbCritical, "员工信息管理"
txtNum.SetFocus
Else
If isRepeat Then
MsgBox "编号:<" & Trim(txtNum) & ">已被使用，请使用其他编号!", vbCritical, "员工信息管理"
txtNum.SetFocus
txtUser.SelStart = 0
Else
'保存记录
If isAdding Then objRs.AddNew
objRs!编号 = txtNum
objRs!姓名 = txtUser
objRs!生日 = txtBirth
objRs!工作时间 = txtTime
If txtDept <> "" Then objRs!部门 = txtDept
objRs!职务 = cmbDuty
objRs!职称 = cmbTitle
If chkHouse = 0 Then
objRs!有住房 = False
Else
objRs!有住房 = True
End If
If chkExpert = 0 Then
objRs!是专家 = False
Else
objRs!是专家 = True
End If
objRs.Update
MsgBox "数据保存成功!", vbInformation, "员工信息管理"
cmdAdd.Enabled = True
cmdDelete.Enabled = True
isAdding = False
picNavigation.Enabled = True
ShowCurrentRecord
End If
End If
Exit Sub
DealError:
msg = "程序执行出错，错误信息如下：" & vbCrLf & Err.Description
ShowError msg
End Sub
'isRepeat函数过程定义:
Private Function isRepeat() As Boolean
'检查当前修改后的用户名是否重复
Dim objCopy As New Recordset
Set objCopy = objRs '.Close(clone不确定)
If objCopy.RecordCount > 0 Then
objCopy.MoveFirst
objCopy.Find "编号='" & Trim(txtNum) & "'"
If objCopy.EOF Then
isRepeat = False
ElseIf isAdding Then
isRepeat = True
ElseIf objCopy.AbsolutePosition <> objRs.AbsolutePosition Then
isRepeat = True
Else
isRepeat = False
End If
Else
isRepeat = False
End If
Set objCopy = Nothing
End Function
Private Sub Form_Load()
On Error GoTo DealError
'建立数据库连接
Set objCn = New Connection
strcn = "Provider=Microsoft.Jet.OLEDB.4.0;" & "Data Source=" & App.Path & "\工资管理.mdb"
objCn.ConnectionString = strcn
objCn.Open
'创建Recordset对象，获取员工信息数据
Set objRs = New Recordset
Set objRs.ActiveConnection = objCn
objRs.CursorLocation = adUseClient
objRs.CursorType = adOpenDynamic
objRs.LockType = adLockOptimistic
Strsql = "SELECT * FROM 员工信息"
objRs.Open Strsql
'显示第一条记录
ShowCurrentRecord
Exit Sub
DealError:
msg = "程序执行出错，错误信息如下：" & vbCrLf & Err.Description
ShowError msg
End Sub
'定义过程ShowCurrentRecord
Private Sub ShowCurrentRecord()
On Error GoTo DealError
If objRs.BOF And objRs.EOF Then
txtNews = "记录:无"
Else
txtNum = objRs!编号
txtUser = objRs!姓名
txtBirth = objRs!生日
txtTime = objRs!工作时间
txtDept = objRs!部门
Select Case objRs!职务
Case "正处"
cmbDuty.ListIndex = 0
Case "副处"
cmbDuty.ListIndex = 1
Case "正科"
cmbDuty.ListIndex = 2
Case "副科"
cmbDuty.ListIndex = 3
Case "一般"
cmbDuty.ListIndex = 4
End Select
Select Case objRs!职称
Case "正高"
cmbTitle.ListIndex = 0
Case "副高"
cmbTitle.ListIndex = 1
Case "中级"
cmbTitle.ListIndex = 2
Case "初级"
cmbTitle.ListIndex = 3
Case "普通"
cmbTitle.ListIndex = 4
End Select
If objRs!有住房 Then
chkHouse = 1
Else
chkHouse = 0
End If
If objRs!是专家 Then
chkExpert = 1
Else
chkExpert = 0
End If
'显示当前记录编号和记录总数
txtNews = "记录:" & objRs.AbsolutePosition & "/" & objRs.RecordCount
End If
Exit Sub
DealError:
msg = "程序执行出错，错误信息如下：" & vbCrLf & Err.Description
ShowError msg
End Sub
Private Sub Form_Unload(Cancel As Integer)
Set objRs = Nothing
objCn.Close
Set objCn = Nothing
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -