人事管理信息系统（access关闭窗体的vba代码）

设计资料

功能模块图

业务流程图

数据流图

E-R图

程序流程图

逻辑结构模型

部门（部门）

调动表（调动ID，员工号，原部门，原职位，调动部门，调动职位，调动日期，调动原因，经办人，备注）

调动原因（调动原因）

职位（职位）

考勤（考勤ID，员工号，考勤年份，考勤月份，出勤，旷工，早退，迟到，请假，出差，加班，备注）

离职（离职ID，员工号，所在部门，职位，离职日期，离职原因，经办人，备注）

离职原因表（离职原因）

状态（状态）

员工（员工号，姓名，性别，籍贯，民族，政治面貌，联系方式，电子邮箱，身份证号，出生日期，学历，家庭住址，部门，职位，入职日期，状态，备注）

数据库

人事管理信息系统后端采用access数据库存储数据，格式为mdb，命名为db_rs，为了保证安全性，数据库设置加密，密码为abc123。

表

部门表

账号表

调动表

调动原因表

职位表

考勤表

离职表

离职原因表

状态表

员工表

表关系

查询

调动查询

SELECT 调动表.* 员工表.姓名

FROM 员工表 INNER JOIN 调动表 ON 员工表.员工号 = 调动表.员工号;

考勤查询

SELECT 考勤表.* 员工表.姓名 员工表.部门 员工表.职位

FROM 员工表 INNER JOIN 考勤表 ON 员工表.员工号 = 考勤表.员工号;

考勤统计查询

SELECT 考勤查询.考勤年份 考勤查询.员工号 考勤查询.姓名 考勤查询.部门 考勤查询.职位 Sum(考勤查询.出勤) AS 出勤合计 Sum(考勤查询.旷工) AS 旷工合计 Sum(考勤查询.早退) AS 早退合计 Sum(考勤查询.迟到) AS 迟到合计 Sum(考勤查询.请假) AS 请假合计 Sum(考勤查询.出差) AS 出差合计 Sum(考勤查询.加班) AS 加班合计

FROM 考勤查询

GROUP BY 考勤查询.考勤年份 考勤查询.员工号 考勤查询.姓名 考勤查询.部门 考勤查询.职位;

离职查询

SELECT 离职表.* 员工表.姓名

FROM 员工表 INNER JOIN 离职表 ON 员工表.员工号 = 离职表.员工号;

员工查询

SELECT 员工表.* Year(Date())-Year([出生日期]) AS 年龄 Year(Date())-Year([入职日期]) AS 公司工龄

FROM 员工表;

员工基本信息查询

SELECT 员工表.员工号 员工表.姓名 员工表.性别 员工表.部门 员工表.职位 员工表.状态

FROM 员工表;

示例模块

离职查询

Option Explicit

Dim dh As Long '存储高度差

Dim dw As Long '存储宽度差

Private Sub Command查询1_Click() '单条件查询

On Error GoTo 结束查询

Dim search_field As String

If Me.查询字段 = "离职日期" Then

If 起始日期 <> "" And IsNull(起始日期) = False And 截止日期 <> "" And IsNull(截止日期) = False And 查询字段 <> "" And IsNull(查询字段) = False Then

search_field = 查询字段

lz_filter = search_field & " between #" & 起始日期 & "# and #" & 截止日期 & "#"

Else

lz_filter = ""

End If

Adodc1.RecordSource = 生成查询语句("离职查询" lz_filter lz_order)

Adodc1.Refresh

DataGrid1.Refresh

DataGrid1.SetFocus

Exit Sub

End If

If Me.查询字段 = "数值" Then

If 最小 <> "" And IsNull(最小) = False And 最大 <> "" And IsNull(最大) = False And 查询字段 <> "" And IsNull(查询字段) = False Then

search_field = 查询字段

lz_filter = search_field & " >= " & 最小 & " And " & search_field & " <= " & 最大

Else

lz_filter = ""

End If

Adodc1.RecordSource = 生成查询语句("离职查询" lz_filter lz_order)

Adodc1.Refresh

DataGrid1.Refresh

DataGrid1.SetFocus

Exit Sub

End If

If 查询内容 <> "" And IsNull(查询内容) = False And 查询字段 <> "" And IsNull(查询字段) = False Then

search_field = 查询字段

lz_filter = search_field & " like '%" & 查询内容 & "%'"

Else

lz_filter = ""

End If

Adodc1.RecordSource = 生成查询语句("离职查询" lz_filter lz_order)

Adodc1.Refresh

DataGrid1.Refresh

DataGrid1.SetFocus

Exit Sub

结束查询:

MsgBox Err.Description "错误提示"

End Sub

Private Sub Command管理_Click()

On Error GoTo A1

lz_num = DataGrid1.Columns(0).Text

frm离职管理.Show 1

A1:

End Sub

Private Sub Command降序_Click()

If 排序 <> "" And IsNull(排序) = False Then

lz_order = 排序 & " DESC"

Else

lz_order = ""

End If

Adodc1.RecordSource = 生成查询语句("离职查询" lz_filter lz_order)

Adodc1.Refresh

DataGrid1.Refresh

DataGrid1.SetFocus

End Sub

Private Sub Command全部_Click()

lz_filter = ""

Adodc1.RecordSource = 生成查询语句("离职查询" lz_filter lz_order)

Adodc1.Refresh

DataGrid1.Refresh

DataGrid1.SetFocus

End Sub

Private Sub Command升序_Click()

If 排序 <> "" And IsNull(排序) = False Then

lz_order = 排序 & " ASC"

Else

lz_order = ""

End If

Adodc1.RecordSource = 生成查询语句("离职查询" lz_filter lz_order)

Adodc1.Refresh

DataGrid1.Refresh

DataGrid1.SetFocus

End Sub

Private Sub Command生成报表_Click()

Dim Cnn As New ADODB.Connection

Dim rs As New ADODB.Recordset

With Cnn 'mdb格式连接

.ConnectionString = "Provider = microsoft.jet.oledb.4.0;data source=" & App.Path & "db_rs.mdb;Jet OLEDB:DataBase password=abc123;persist security info=false"

.Open

End With

Dim rs_sql As String

rs_sql = 生成查询语句("离职查询" lz_filter lz_order)

rs.Open rs_sql Cnn adOpenDynamic adLockOptimistic

Set DataReport离职报表.DataSource = rs

DataReport离职报表.Show 1

End Sub

Private Sub Command添加_Click()

If 离职添加权限 = False Then

MsgBox "无权限"

Exit Sub

End If

frm离职添加.Show 1

End Sub

Private Sub Form_Load()

'筛选排序变量清空

lz_filter = ""

lz_order = "离职ID DESC"

查询内容.Visible = True

'--隐藏日期控件

起始日期.Visible = False

截止日期.Visible = False

'--隐藏金额控件

最小.Visible = False

最大.Visible = False

'标签

Label查询内容.Visible = True

'--隐藏日期控件

Label起始日期.Visible = False

Label截止日期.Visible = False

'--隐藏金额控件

Label最小.Visible = False

Label最大.Visible = False

'ado控件设置

Adodc1.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "db_rs.mdb;Jet OLEDB:DataBase password=abc123;Persist Security Info=False"

Adodc1.CommandType = adCmdUnknown

Adodc1.RecordSource = 生成查询语句("离职查询" lz_filter lz_order)

Adodc1.Refresh '刷新

'存储数据表格控件与窗体宽高差值

dh = Me.Height - DataGrid1.Height

dw = Me.Width - DataGrid1.Width

End Sub

Function 生成查询语句(ByVal searchtb As String ByVal searchfilter As String ByVal searchorder As String) As String

生成查询语句 = ""

Dim sqltext As String

sqltext = "Select * From " & searchtb

If searchfilter <> "" Then

sqltext = sqltext & " where " & searchfilter

End If

If searchorder <> "" Then

sqltext = sqltext & " order by " & searchorder

End If

生成查询语句 = sqltext

End Function

Private Sub Form_Resize()

'窗体大小变化表格控件尺寸改变

If Me.WindowState <> 1 Then

DataGrid1.Height = Me.Height - dh

DataGrid1.Width = Me.Width - dw

End If

End Sub

Private Sub 查询字段_Click()

If Me.查询字段 = "离职日期" Then

起始日期.Visible = True

截止日期.Visible = True

最小.Visible = False

最大.Visible = False

查询内容.Visible = False

起始日期.Value = Date

截止日期.Value = Date

GoTo A1

Else

起始日期.Visible = False

截止日期.Visible = False

最小.Visible = False

最大.Visible = False

查询内容.Visible = True

End If

If Me.查询字段 = "数值" Then

起始日期.Visible = False

截止日期.Visible = False

最小.Visible = True

最大.Visible = True

查询内容.Visible = False

GoTo A1

Else

起始日期.Visible = False

截止日期.Visible = False

最小.Visible = False

最大.Visible = False

查询内容.Visible = True

End If

A1:

'标签

If Me.查询字段 = "离职日期" Then

Label起始日期.Visible = True

Label截止日期.Visible = True

Label最小.Visible = False

Label最大.Visible = False

Label查询内容.Visible = False

GoTo a2

Else

Label起始日期.Visible = False

Label截止日期.Visible = False

Label最小.Visible = False

Label最大.Visible = False

Label查询内容.Visible = True

End If

If Me.查询字段 = "数值" Then

Label起始日期.Visible = False

Label截止日期.Visible = False

Label最小.Visible = True

Label最大.Visible = True

Label查询内容.Visible = False

GoTo a2

Else

Label起始日期.Visible = False

Label截止日期.Visible = False

Label最小.Visible = False

Label最大.Visible = False

Label查询内容.Visible = True

End If

a2:

End Sub

离职添加

Dim dh As Long '存储高度差

Dim dw As Long '存储宽度差

Private Sub Text_DblClick(Index As Integer)

If Index = 3 Then

If Text(3).Text = "" Then

Text(3).Text = Date

Exit Sub

End If

End If

If Index = 0 Then

yg_formname = "frm离职添加"

frm员工选择.Show 1

End If

End Sub

Private Sub Command清空_Click()

Text(0).Text = ""

Text(1).Text = ""

Text(2).Text = ""

Text(3).Text = ""

Combo1(0).Text = ""

Combo1(1).Text = ""

Combo1(3).Text = ""

End Sub

Private Sub Command添加_Click()

On Error GoTo 错误提示

If 离职添加权限 = False Then

MsgBox "无权限"

Exit Sub

End If

'判断必须输入数据的控件不能为空

If Text(0) = "" Or IsNull(Text(0)) = True Then

MsgBox "员工号值为空！"

Exit Sub

Else

End If

'检查员工号是否已存在

If dcountlink("员工号" "员工表" "员工号='" & Text(0) & "'" 0) = 0 Then

MsgBox "该员工号不存在，请修改后重试"

Exit Sub

End If

Dim alz_conn As New ADODB.Connection

Dim alz_rs As New ADODB.Recordset

With alz_conn

.ConnectionString = "Provider = microsoft.jet.oledb.4.0;data source=" & App.Path & "db_rs.mdb;Jet OLEDB:DataBase password=abc123;persist security info=false"

.Open

End With

alz_rs.Open "离职表" alz_conn adOpenKeyset adLockOptimistic

alz_rs.AddNew

On Error Resume Next

alz_rs!员工号.Value = Text(0).Text

alz_rs!经办人.Value = Text(1).Text

alz_rs!备注.Value = Text(2).Text

alz_rs!离职日期.Value = Text(3).Text

alz_rs!职位.Value = Combo1(0).Text

alz_rs!所在部门.Value = Combo1(1).Text

alz_rs!离职原因.Value = Combo1(3).Text

alz_rs.Update

alz_rs.Close

Set alz_rs = Nothing

alz_conn.Close

Set alz_conn = Nothing

MsgBox "添加完成"

Call Command清空_Click

Adodc1.Refresh

DataGrid1.Refresh

Exit Sub

错误提示:

MsgBox Err.Description "错误提示"

End Sub

Private Sub Form_Load()

Call 设置部门选项

Call 设置职位选项

Call 设置离职原因选项

'ado控件设置

Me.Adodc1.CommandType = adCmdUnknown

Me.Adodc1.RecordSource = "select * From 离职表 Order By 离职ID DESC"

Me.Adodc1.Refresh '刷新

'

'存储数据表格控件与窗体宽高差值

dh = Me.Height - DataGrid1.Height

dw = Me.Width - DataGrid1.Width

End Sub

Private Sub Form_Resize()

'窗体大小变化表格控件尺寸改变

If Me.WindowState <> 1 Then

DataGrid1.Height = Me.Height - dh

DataGrid1.Width = Me.Width - dw

End If

End Sub

Private Sub Form_Unload(Cancel As Integer)

On Error Resume Next

frm离职查询.Adodc1.Refresh

frm离职查询.DataGrid1.Refresh

End Sub

Private Sub Text_LostFocus(Index As Integer)

If Index = 3 Then '输入日期的文本框失去焦点

If Text(3).Text <> "" And IsDate(Text(3)) = False Then

MsgBox "输入的数据不是日期类型，请重新输入"

Text(3).Text = ""

Exit Sub

End If

End If

'If Index = 9 Then '输入日期的文本框失去焦点

' If Text(9).Text <> "" And IsDate(Text(9)) = False Then

' MsgBox "输入的数据不是日期类型，请重新输入"

' Text(9).Text = ""

' Exit Sub

' End If

'End If

End Sub

Sub 设置部门选项()

Dim i As Long

'-清除选项

Combo1(1).Clear

'-查询并填充选项

On Error GoTo 查询失败错误

Dim search_conn As New ADODB.Connection

Dim search_rs As New ADODB.Recordset

With search_conn

.ConnectionString = "Provider = microsoft.jet.oledb.4.0;data source=" & App.Path & "db_rs.mdb;Jet OLEDB:DataBase password=abc123;persist security info=false"

.Open

End With

Dim search_sql As String

search_sql = "Select * From 部门表"

search_rs.Open search_sql search_conn adOpenDynamic adLockOptimistic

'

Do While search_rs.EOF = False

If search_rs!部门 <> "" Then

Combo1(1).AddItem search_rs!部门

End If

search_rs.MoveNext

Loop

'

search_rs.Close

Set search_rs = Nothing

search_conn.Close

Set search_conn = Nothing

Exit Sub

查询失败错误:

MsgBox Err.Description "错误提示"

End Sub

Sub 设置职位选项()

Dim i As Long

'-清除选项

Combo1(0).Clear

'-查询并填充选项

On Error GoTo 查询失败错误

Dim search_conn As New ADODB.Connection

Dim search_rs As New ADODB.Recordset

With search_conn

.ConnectionString = "Provider = microsoft.jet.oledb.4.0;data source=" & App.Path & "db_rs.mdb;Jet OLEDB:DataBase password=abc123;persist security info=false"

.Open

End With

Dim search_sql As String

search_sql = "Select * From 职位表"

search_rs.Open search_sql search_conn adOpenDynamic adLockOptimistic

'

Do While search_rs.EOF = False

If search_rs!职位 <> "" Then

Combo1(0).AddItem search_rs!职位

End If

search_rs.MoveNext

Loop

'

search_rs.Close

Set search_rs = Nothing

search_conn.Close

Set search_conn = Nothing

Exit Sub

查询失败错误:

MsgBox Err.Description "错误提示"

End Sub

Sub 设置离职原因选项()

Dim i As Long

'-清除选项

Combo1(3).Clear

'-查询并填充选项

On Error GoTo 查询失败错误

Dim search_conn As New ADODB.Connection

Dim search_rs As New ADODB.Recordset

With search_conn

.ConnectionString = "Provider = microsoft.jet.oledb.4.0;data source=" & App.Path & "db_rs.mdb;Jet OLEDB:DataBase password=abc123;persist security info=false"

.Open

End With

Dim search_sql As String

search_sql = "Select * From 离职原因表"

search_rs.Open search_sql search_conn adOpenDynamic adLockOptimistic

'

Do While search_rs.EOF = False

If search_rs!离职原因 <> "" Then

Combo1(3).AddItem search_rs!离职原因

End If

search_rs.MoveNext

Loop

'

search_rs.Close

Set search_rs = Nothing

search_conn.Close

Set search_conn = Nothing

Exit Sub

查询失败错误:

MsgBox Err.Description "错误提示"

End Sub

离职管理

Private Sub Command更新_Click()

On Error GoTo 更新失败错误

If 离职更新权限 = False Then

MsgBox "无权限"

Exit Sub

End If

If MsgBox("是否更新该离职记录?" vbOKCancel) <> vbOK Then

Exit Sub

End If

If Text(0) = "" Or IsNull(Text(0)) = True Then

MsgBox "员工号值为空！"

Exit Sub

Else

End If

If dcountlink("员工号" "员工表" "员工号='" & Text(0) & "'" 0) = 0 Then

MsgBox "该员工号不存在，请修改后重试"

Exit Sub

End If

'连接数据库并更新

Adodc1.Recordset.Update

MsgBox "更新完成！"

Exit Sub

更新失败错误:

MsgBox Err.Description "错误提示"

End Sub

Private Sub Command删除_Click()

On Error GoTo 删除失败错误

If 离职删除权限 = False Then

MsgBox "无权限"

Exit Sub

End If

If MsgBox("是否删除该离职记录?" vbOKCancel) <> vbOK Then

Exit Sub

End If

Adodc1.Recordset.Delete

MsgBox "删除完成"

Unload Me

Exit Sub

删除失败错误:

MsgBox Err.Description "错误提示"

End Sub

Private Sub Form_Load()

Call 设置部门选项

Call 设置职位选项

Call 设置离职原因选项

'ado控件设置

Me.Adodc1.Refresh '刷新

Me.Adodc1.CommandType = adCmdUnknown

Me.Adodc1.RecordSource = "select * From 离职表 where 离职ID=" & lz_num

Me.Adodc1.Refresh '刷新

End Sub

Private Sub Form_Unload(Cancel As Integer)

On Error Resume Next

frm离职查询.Adodc1.Refresh

frm离职查询.DataGrid1.Refresh

End Sub

Private Sub Text_DblClick(Index As Integer)

If Index = 3 Then

If Text(3).Text = "" Then

Text(3).Text = Date

Exit Sub

End If

End If

If Index = 0 Then

yg_formname = "frm离职管理"

frm员工选择.Show 1

End If

End Sub

Sub 设置部门选项()

Dim i As Long

'-清除选项

Combo1(1).Clear

'-查询并填充选项

On Error GoTo 查询失败错误

Dim search_conn As New ADODB.Connection

Dim search_rs As New ADODB.Recordset

With search_conn

.ConnectionString = "Provider = microsoft.jet.oledb.4.0;data source=" & App.Path & "db_rs.mdb;Jet OLEDB:DataBase password=abc123;persist security info=false"

.Open

End With

Dim search_sql As String

search_sql = "Select * From 部门表"

search_rs.Open search_sql search_conn adOpenDynamic adLockOptimistic

'

Do While search_rs.EOF = False

If search_rs!部门 <> "" Then

Combo1(1).AddItem search_rs!部门

End If

search_rs.MoveNext

Loop

'

search_rs.Close

Set search_rs = Nothing

search_conn.Close

Set search_conn = Nothing

Exit Sub

查询失败错误:

MsgBox Err.Description "错误提示"

End Sub

Sub 设置职位选项()

Dim i As Long

'-清除选项

Combo1(0).Clear

'-查询并填充选项

On Error GoTo 查询失败错误

Dim search_conn As New ADODB.Connection

Dim search_rs As New ADODB.Recordset

With search_conn

.ConnectionString = "Provider = microsoft.jet.oledb.4.0;data source=" & App.Path & "db_rs.mdb;Jet OLEDB:DataBase password=abc123;persist security info=false"

.Open

End With

Dim search_sql As String

search_sql = "Select * From 职位表"

search_rs.Open search_sql search_conn adOpenDynamic adLockOptimistic

'

Do While search_rs.EOF = False

If search_rs!职位 <> "" Then

Combo1(0).AddItem search_rs!职位

End If

search_rs.MoveNext

Loop

'

search_rs.Close

Set search_rs = Nothing

search_conn.Close

Set search_conn = Nothing

Exit Sub

查询失败错误:

MsgBox Err.Description "错误提示"

End Sub

Sub 设置离职原因选项()

Dim i As Long

'-清除选项

Combo1(3).Clear

'-查询并填充选项

On Error GoTo 查询失败错误

Dim search_conn As New ADODB.Connection

Dim search_rs As New ADODB.Recordset

With search_conn

.ConnectionString = "Provider = microsoft.jet.oledb.4.0;data source=" & App.Path & "db_rs.mdb;Jet OLEDB:DataBase password=abc123;persist security info=false"

.Open

End With

Dim search_sql As String

search_sql = "Select * From 离职原因表"

search_rs.Open search_sql search_conn adOpenDynamic adLockOptimistic

'

Do While search_rs.EOF = False

If search_rs!离职原因 <> "" Then

Combo1(3).AddItem search_rs!离职原因

End If

search_rs.MoveNext

Loop

'

search_rs.Close

Set search_rs = Nothing

search_conn.Close

Set search_conn = Nothing

Exit Sub

查询失败错误:

MsgBox Err.Description "错误提示"

End Sub

以上内容仅供参考，如需获取原文件代码设计报告等资料，可访问同名↓