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

威哥 2023-10-20 12:04:38 836

access关闭窗体的vba代码（人事管理信息系统）调动原因（调动原因）调动表（调动ID，员工号，原部门，原职位，调动部门，调动职位，调动日期，调动原因，经办人，备注）程序流程图逻辑结构模型部门（部门）

设计资料

功能模块图

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

业务流程图

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

数据流图

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

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

E-R图

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

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

程序流程图

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

逻辑结构模型

部门（部门）

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

调动原因（调动原因）

职位（职位）

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

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

离职原因表（离职原因）

状态（状态）

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

数据库

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

表

部门表

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

账号表

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

调动表

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

调动原因表

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

职位表

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

考勤表

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

离职表

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

离职原因表

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

状态表

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

员工表

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

表关系

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

查询

调动查询

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

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

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

考勤查询

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

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

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

考勤统计查询

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

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

FROM 考勤查询

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

离职查询

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

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

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

员工查询

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

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

FROM 员工表;

员工基本信息查询

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

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

FROM 员工表;

示例模块

离职查询

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

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

离职添加

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

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

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

'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

离职管理

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

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

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