【人事管理信息系統(tǒng)】 設計報告資料和示例代碼分享 VB程序 Access數(shù)據(jù)庫
設計資料
功能模塊圖
業(yè)務流程圖
數(shù)據(jù)流圖
E-R圖
程序流程圖
邏輯結構模型
部門（部門）
調動表（調動ID，員工號，原部門，原職位，調動部門，調動職位，調動日期，調動原因，經(jīng)辦人，備注）
調動原因（調動原因）
職位（職位）
考勤（考勤ID，員工號，考勤年份，考勤月份，出勤，曠工，早退，遲到，請假，出差，加班，備注）
離職（離職ID，員工號，所在部門，職位，離職日期，離職原因，經(jīng)辦人，備注）
離職原因表（離職原因）
狀態(tài)（狀態(tài)）
員工（員工號，姓名，性別，籍貫，民族，政治面貌，聯(lián)系方式，電子郵箱，身份證號，出生日期，學歷，家庭住址，部門，職位，入職日期，狀態(tài)，備注）
數(shù)據(jù)庫
人事管理信息系統(tǒng)后端采用access數(shù)據(jù)庫存儲數(shù)據(jù)，格式為mdb，命名為db_rs，為了保證安全性，數(shù)據(jù)庫設置加密，密碼為abc123。
表
部門表
賬號表
調動表
調動原因表
職位表
考勤表
離職表
離職原因表
狀態(tài)表
員工表
表關系
查詢
調動查詢
SELECT 調動表.*, 員工表.姓名
FROM 員工表 INNER JOIN 調動表 ON 員工表.員工號 = 調動表.員工號;
考勤查詢
SELECT 考勤表.*, 員工表.姓名, 員工表.部門, 員工表.職位
FROM 員工表 INNER JOIN 考勤表 ON 員工表.員工號 = 考勤表.員工號;
考勤統(tǒng)計查詢
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 員工表.員工號, 員工表.姓名, 員工表.性別, 員工表.部門, 員工表.職位, 員工表.狀態(tài)
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.查詢字段 = "數(shù)值" 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 '刷新
'存儲數(shù)據(jù)表格控件與窗體寬高差值
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.查詢字段 = "數(shù)值" 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.查詢字段 = "數(shù)值" 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
'判斷必須輸入數(shù)據(jù)的控件不能為空
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!經(jīng)辦人.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 '刷新
'
'存儲數(shù)據(jù)表格控件與窗體寬高差值
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 "輸入的數(shù)據(jù)不是日期類型，請重新輸入"
Text(3).Text = ""
Exit Sub
End If
End If
'If Index = 9 Then '輸入日期的文本框失去焦點
' If Text(9).Text <> "" And IsDate(Text(9)) = False Then
' MsgBox "輸入的數(shù)據(jù)不是日期類型，請重新輸入"
' 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
'連接數(shù)據(jù)庫并更新
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
以上內容僅供參考，如需獲取原文件代碼設計報告等資料，可訪問同名↓
