Visual Basic 6.0 (VB6) 程式語言案例學習 (02. 加班薪資管理系統)
Visual Basic 6.0 (VB6) 程式語言案例學習 (02. 加班薪資管理系統)¶
2.1 問題¶
某會計室因為採用紙本的方式統計加班薪資的工作，每個月都相當的麻煩，必須請工讀生或是助理來協助統計這堆成山的加班申請單，而且有時還會因為人為的因素，造成統計錯誤。例如填單者的字太潦草、登記者看錯數字、單據未經主管審核、…、等等。一連串的問題，造成工作的繁雜。因此才想出使用電腦來協助解決問題，希望能夠由電腦自動統計出加班的時數，藉以解決問題。
2.2 需求¶
表格 2‑1 「加班薪資管理系統」系統目的分析表
| 版本：1.0 | 要做什麼 | 不要做什麼（不要做不代表不會做） |
|---|---|---|
| 能做什麼 | （第一格：必要項目） | （第二格：次要項目） |
| 輸入單據時，只要輸入編號就可以帶出人員的相關資料。 | 資料庫要加密。 | |
| 新增加班時數的時候要能判斷是否與之前的時數有重疊。 | 所有功能都要能顯示提示操作，以便於初學者使用。 | |
| 要有權限管理，不同權限的角色只能看到所屬的功能。 | ||
| 操作介面最好一致，以便讓管理者熟悉。 | ||
| 可以批次作業，節省時間。 | ||
| 經過稽核後的單據就不可以再去修改。 | ||
| 不能做什麼（不能做代表不需要做） | （第三格：不必要項目） | （第四格：不需要項目） |
| 要能夠匯出報表，統計誰的加班時數及金額最多。 | 將人員管理資料庫與校務系統結合。 |
表格 2‑2 「加班薪資管理系統」系統目標分析表
| 版本： | 重要 | 不重要 |
|---|---|---|
| 優先 | （重） | （急） |
| 輸入單據時，只要輸入編號就可以帶出人員的相關資料。 | 要有權限管理，不同權限的角色只能看到所屬的功能。 | |
| 新增加班時數的時候要能判斷是否與之前的時數有重疊。 | ||
| 經過稽核後的單據就不可以再去修改。 | ||
| 不急迫 | （輕） | （緩） |
| 操作介面最好一致，以便讓管理者熟悉。 | 可以批次作業，節省時間。 |
表格 2‑3 「加班薪資管理系統」系統規格表
| 規格項目 | 規格內容 | 備註 |
|---|---|---|
| 登入介面 | 依據使用者不同而分為管理者、稽核者、輸入者三種權限功能。 | … |
| 加班單 | 能夠判別錯誤的時間登錄，只允許正確的資料進入系統。 | … |
| 稽核單 | 能夠批次稽核及取消加班單據。 | … |
| 統計單 | 提供三種計算薪資的方法，可以依照不同屬性的員工，量身訂作加班薪資計算法。 | … |
| 職員管理 | 可以新增、刪除、修改職員資料。 | … |
2.3 特色¶
特點就是透過數學運算，讓原本複雜的計算公式，變得簡單又有效率，管理職員六百多人的加班薪資計算。
可應用於公司行號開發計算複雜薪資的程式。
2.4 使用工具¶
| 語言 | 軟體 |
|---|---|
| Visual Basic 6.0 | MS Visual Basic 6.0、MS Access |
2.5 系統架構¶
筆者藉由訪談了解使用該系統的人員角色，分為管理者、稽核者、輸入者。所謂管理者可以使用系統全部功能，相當於會計主任的等級；稽核者就是會計本身，資料進入並不代表一定通過核發薪資的條件，因此必須經過會計依據條件審核；輸入者權限最小，可以由工讀生或者是助理來協助輸入，並不牽涉到任何薪資發放的部分。
由此看來這系統是依據角色的不同而規劃的，由於是會計系統又牽涉到金錢，因此設計時就必須包含權限。而筆者預估未來有可能還會增加功能，因此設計上採用使用者自訂控制項的方式，並且每個自訂控制項之間並無關連，控制項只針對資料庫做處理分析，因此再使用率相當高，得以隨時置換不同的控制項，來滿足使用者的需求。
透過簡單的數學運算可以節省許多邏輯判斷的程式碼，而且又有效率。
2.6 程式實作¶
2.6.1 加班薪資管理系統之介面設計¶
Step 1：因為本程式是以角色來看，因此先介紹介面程式的部分，讓讀者能夠先清楚介面及角色的概觀。請參考如圖2-1的介面安排。
圖 2‑1 加班薪資管理系統之使用者介面
Step 2：請將以下程式碼加入介面中。
'設定所有變數必須宣告才能使用
Option Explicit
'登入介面程式初始化事件副程式
Private Sub Form_Initialize()
'設定有功能的功能鈕隱藏，尚未登入前是不能使用
Toolbar1.Buttons(1).Visible = False
Toolbar1.Buttons(2).Visible = False
Toolbar1.Buttons(3).Visible = False
Toolbar1.Buttons(4).Visible = False
'設定方框背景圖型的位置、大小
Shape2.Left = 0
Shape2.Top = Toolbar1.Height + Screen.TwipsPerPixelY
Shape2.Width = frmMM.Width - Screen.TwipsPerPixelX * 8
'設定加班時間表自製控制項的位置、大小
UserControl21.Visible = False
UserControl21.Top = Toolbar1.Top + Toolbar1.Height
UserControl21.Left = 0
UserControl21.Height = frmMM.Height - Toolbar1.Height
UserControl21.Width = frmMM.Width
'設定加班時間稽核表自製控制項的位置、大小
UserControl31.Visible = False
UserControl31.Top = Toolbar1.Top + Toolbar1.Height
UserControl31.Left = 0
UserControl31.Height = frmMM.Height - Toolbar1.Height
UserControl31.Width = frmMM.Width
'設定加班時間統計表自製控制項的位置、大小
UserControl41.Visible = False
UserControl41.Top = Toolbar1.Top + Toolbar1.Height
UserControl41.Left = 0
UserControl41.Height = frmMM.Height - Toolbar1.Height
UserControl41.Width = frmMM.Width
'設定職員資料管理自製控制項的位置、大小
UserControl51.Visible = False
UserControl51.Top = Toolbar1.Top + Toolbar1.Height
UserControl51.Left = 0
UserControl51.Height = frmMM.Height - Toolbar1.Height
UserControl51.Width = frmMM.Width
End Sub
'登入按鍵被點選事件副程式
Private Sub Command1_Click()
'假設管理者登入判斷，帳號：管理者、密碼：ADMIN
If Text1.Text = "管理者" And Text2.Text = "ADMIN" Then
'設定管理者可使用的功能
Toolbar1.Buttons(1).Visible = True
Toolbar1.Buttons(2).Visible = True
Toolbar1.Buttons(3).Visible = True
Toolbar1.Buttons(4).Visible = True
'隱藏初始登入介面控制項
Shape1.Visible = False
Shape2.Visible = False
Text1.Visible = False
Text2.Visible = False
Label1.Visible = False
Label2.Visible = False
Command1.Visible = False
Command2.Visible = False
'假設稽核者登入判斷，帳號：稽核者、密碼：CHECK
ElseIf Text1.Text = "稽核者" And Text2.Text = "CHECK" Then
'設定稽核者可使用的功能
Toolbar1.Buttons(2).Visible = True
Toolbar1.Buttons(3).Visible = True
'隱藏初始登入介面控制項
Shape1.Visible = False
Shape2.Visible = False
Text1.Visible = False
Text2.Visible = False
Label1.Visible = False
Label2.Visible = False
Command1.Visible = False
Command2.Visible = False
'假設輸入者登入判斷，帳號：稽核者、密碼：CHECK
ElseIf Text1.Text = "輸入者" And Text2.Text = "ACC" Then
'設定輸入者可使用的功能
Toolbar1.Buttons(1).Visible = True
'隱藏初始登入介面控制項
Shape1.Visible = False
Shape2.Visible = False
Text1.Visible = False
Text2.Visible = False
Label1.Visible = False
Label2.Visible = False
Command1.Visible = False
Command2.Visible = False
End If
End Sub
'宣告清除按鈕事件副程式
Private Sub Command2_Click()
'清除帳號及密碼文字框
Text1.Text = ""
Text2.Text = ""
End Sub
'宣告功能列按鈕被點選事件副程式
Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
'先隱藏所有自訂控制項
UserControl21.Visible = False
UserControl31.Visible = False
UserControl41.Visible = False
UserControl51.Visible = False
'依據按鈕鍵判斷該顯示的自動控制項
Select Case Button.Key
'設定加班時間表自製控制項的位置、大小
Case "IK2"
UserControl21.Reload
UserControl21.Top = Toolbar1.Top + Toolbar1.Height
UserControl21.Left = 0
UserControl21.Height = frmMM.Height - Toolbar1.Height
UserControl21.Width = frmMM.Width - (Screen.TwipsPerPixelX * 8)
UserControl21.Visible = True
'設定加班時間稽核表自製控制項的位置、大小
Case "IK3"
UserControl31.Reload
UserControl31.Top = Toolbar1.Top + Toolbar1.Height
UserControl31.Left = 0
UserControl31.Height = frmMM.Height - Toolbar1.Height
UserControl31.Width = frmMM.Width - (Screen.TwipsPerPixelX * 8)
UserControl31.Visible = True
'設定加班時間統計表自製控制項的位置、大小
Case "IK4"
UserControl41.Reload
UserControl41.Top = Toolbar1.Top + Toolbar1.Height
UserControl41.Left = 0
UserControl41.Height = frmMM.Height - Toolbar1.Height
UserControl41.Width = frmMM.Width - (Screen.TwipsPerPixelX * 8)
UserControl41.Visible = True
'設定職員資料管理自製控制項的位置、大小
Case "IK5"
UserControl51.Top = Toolbar1.Top + Toolbar1.Height
UserControl51.Left = 0
UserControl51.Height = frmMM.Height - Toolbar1.Height
UserControl51.Width = frmMM.Width - (Screen.TwipsPerPixelX * 8)
UserControl51.Visible = True
'結束程式
Case "IK6"
End
End Select
End Sub
2.6.2 加班時間表之控制項設計¶
Step 1：這是加班單填入的控制項，為求資料進入正確，我們在這裡用數學計算的方式，驗證資料是否符合條件，讓正確的資料進入。避免GIGO（垃圾進，垃圾出）的情形。請參考如圖2-2的版面配置。
圖 2‑2 加班時間表之控制項設計
Step 2：請加以下程式碼加入使用者自訂控制項中。
'設定所有變數必須宣告才能使用
Option Explicit
'宣告ADO資料庫連結物件
Dim objCnn As ADODB.Connection
'宣告ADO資料錄物件
Dim objRst As ADODB.Recordset
'宣告清單項目物件
Dim objItem As ListItem
'使用者自訂控制項初始化事件副程式
Private Sub UserControl_Initialize()
'建立ADO資料庫連結物件
Set objCnn = New ADODB.Connection
'透過連結字串開啟資料庫的連結
objCnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & App.Path & "\db1.mdb;" & _
"Persist Security Info=False"
'建立ADO資料錄物件
Set objRst = New ADODB.Recordset
'增加年度下拉式選單項目，您也可以使用迴圈的方式增加項目
Combo1.AddItem "93", 0
Combo1.AddItem "94", 1
Combo1.AddItem "95", 2
Combo1.AddItem "96", 3
Combo1.AddItem "97", 4
Combo1.AddItem "98", 5
Combo1.AddItem "99", 6
Combo1.ListIndex = 0
'增加月份下拉式選單項目，您也可以使用迴圈的方式增加項目
Combo2.AddItem "01", 0
Combo2.AddItem "02", 1
Combo2.AddItem "03", 2
Combo2.AddItem "04", 3
Combo2.AddItem "05", 4
Combo2.AddItem "06", 5
Combo2.AddItem "07", 6
Combo2.AddItem "08", 7
Combo2.AddItem "09", 8
Combo2.AddItem "10", 9
Combo2.AddItem "11", 10
Combo2.AddItem "12", 11
Combo2.ListIndex = Val(Month(Date)) - 1
'設定日期及時間控制項的數值，調用系統日期
DTPicker1.Value = Date
DTPicker2.Value = Date
DTPicker3.Value = Time
DTPicker4.Value = Time
'設定背景圖型的大小及位置
Shape2.Left = 0
Shape2.Width = UserControl.Width
End Sub
'當年度下拉式選單點選之後事件副程式
Private Sub Combo1_Click()
'載入職員姓名自訂副程式
Call loadName
End Sub
'當月份下拉式選單點選之後事件副程式
Private Sub Combo2_Click()
'載入職員姓名自訂副程式
Call loadName
End Sub
'新增按鈕點選事件副程式
Private Sub Command1_Click()
'宣告所需要用到的字串變數
Dim strRecord_A, strRecord_B, strRecord_C, strRecord_D, strRecord_E, _
strRecord_F, strRecord_G, strRecord_H, strRecord_I, strRecord_J, _
strRecord_K, strRecord_L As String
'判斷人員編號是否有輸入
If Len(Text1.Text) <= 0 Then
labMessage.ForeColor = vbRed
labMessage.Caption = "訊息：尚未輸入人員編號。"
Exit Sub
End If
'判斷人員姓名是否有帶出
If Len(Text4.Text) <= 0 Then
labMessage.ForeColor = vbRed
labMessage.Caption = "訊息：尚未帶出正確的人員姓名，請輸入正確的人員編號。"
Exit Sub
End If
'判斷加班事由是否有輸入
If Len(Text3.Text) <= 0 Then
labMessage.ForeColor = vbRed
labMessage.Caption = "訊息：尚未輸入加班事由。"
Exit Sub
End If
'判斷是否有輸入加班小時金額
If Len(Text2.Text) <= 0 Then
labMessage.ForeColor = vbRed
labMessage.Caption = "訊息：尚未輸入每小時金額。"
Exit Sub
End If
'要加入日期時間的輸入判斷，開始日期不可以大於結束日期
Dim dtmStart As Date
Dim dtmEnd As Date
'設定起始日期時間及結束日期時間
dtmStart = CDate(DTPicker1.Value) & TimeValue(DTPicker3.Value)
dtmEnd = CDate(DTPicker2.Value) & TimeValue(DTPicker4.Value)
'判斷起始日期時間是否大於結束日期時間
If dtmStart >= dtmEnd Then
labMessage.ForeColor = vbRed
labMessage.Caption = "訊息：輸入的日期時間不正確。"
Exit Sub
End If
'判斷日期時間是否有重疊
Dim lngI As Long
Dim str_DontAdd As String
'清除通過旗標
str_DontAdd = ""
'初始化計數器
lngI = 0
'巡覽所有加班項目
For lngI = 1 To ListView1.ListItems.Count
'設定顏色
ListView1.ListItems(lngI).ListSubItems(2).ForeColor = vbBlack
'宣告必須使用的變數
Dim lng_DateTimeRange_Record As Long
Dim lng_DateTimeRange_New As Long
Dim lng_DateTimeRange_Max As Long
Dim dtmStart_Record As Date
Dim dtmEnd_Record As Date
Dim dtmStart_New As Date
Dim dtmEnd_New As Date
Dim dtmStart_Max As Date
Dim dtmEnd_Max As Date
'設定該列加班項目的起始日期時間與結束日期時間
dtmStart_Record = CDate(ListView1.ListItems(lngI).SubItems(4)) & TimeValue(ListView1.ListItems(lngI).SubItems(5))
dtmEnd_Record = CDate(ListView1.ListItems(lngI).SubItems(6)) & TimeValue(ListView1.ListItems(lngI).SubItems(7))
'計算加班日期時間範圍
lng_DateTimeRange_Record = Val(FormatInterval(dtmStart_Record, dtmEnd_Record, "M:SS", 1028))
'設定新增的加班起始日期時間與結束日期時間
dtmStart_New = CDate(DTPicker1.Value) & " " & Format(TimeValue(DTPicker3.Value), "HH:MM")
dtmEnd_New = CDate(DTPicker2.Value) & " " & Format(TimeValue(DTPicker4.Value), "HH:MM")
'計算新增的加班日期時間範圍
lng_DateTimeRange_New = Val(FormatInterval(dtmStart_New, dtmEnd_New, "M:SS", 1028))
'設定最大起始日期時間
dtmStart_Max = dtmStart_New
If dtmStart_Record <= dtmStart_New Then
dtmStart_Max = dtmStart_Record
End If
'設定最大結束日期時間
dtmEnd_Max = dtmEnd_New
If dtmEnd_Record >= dtmEnd_New Then
dtmEnd_Max = dtmEnd_Record
End If
'計算最大起始與結束日期時間範圍
lng_DateTimeRange_Max = Val(FormatInterval(dtmStart_Max, dtmEnd_Max, "M:SS", 1028))
'倘若最大時間範圍減去已紀錄的時間範圍並加上新的時間範圍，計算結果若小於等於零時
If lng_DateTimeRange_Max - (lng_DateTimeRange_Record + lng_DateTimeRange_New) <= 0 Then
'設定顏色提醒
ListView1.ListItems(lngI).ListSubItems(2).ForeColor = vbRed
ListView1.Refresh
'顯示訊息
labMessage.ForeColor = vbRed
labMessage.Caption = "訊息：加班時間有重疊。"
'設定加班項目有誤旗標
str_DontAdd = "Yes"
End If
Next lngI
'倘若新增的加班項目有誤，則跳離副程式
If str_DontAdd = "Yes" Then
Exit Sub
End If
'通過檢查，開始紀錄資料
ListView1.Refresh
'重設訊息
labMessage.ForeColor = vbBlack
labMessage.Caption = "訊息："
'設定各欄位的紀錄變數
strRecord_A = Trim(Combo1.Text & "")
strRecord_B = Trim(Combo2.Text & "")
strRecord_C = Trim(Text1.Text & "")
strRecord_D = Trim(Text4.Text & "")
strRecord_E = Trim(Text3.Text & "")
strRecord_F = DTPicker1.Value
strRecord_G = DTPicker3.Value
strRecord_I = DTPicker2.Value
strRecord_J = DTPicker4.Value
strRecord_K = Trim(Text2.Text & "")
strRecord_L = Trim(Text5.Text & "")
'宣告新增的項目必須使用到的物件及變數
Dim objCnn_ADD As ADODB.Connection
Dim objRst_Add As ADODB.Recordset
Dim strSQL As String
'建立新增項目必須使用到的資料庫物件
Set objCnn_ADD = New ADODB.Connection
Set objRst_Add = New ADODB.Recordset
'設定連結資料庫的命令文字
strSQL = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & App.Path & "\db1.mdb" & ";" & _
"Mode=Read|Write|Share Deny None;" & _
"Persist Security Info=False;"
'開啟資料庫
objCnn_ADD.Open strSQL
'設定SQL的命令文字
strSQL = "Select * From [資料表1]"
'開啟資料錄
objRst_Add.Open strSQL, objCnn_ADD, adOpenStatic, adLockPessimistic
'設定準備新增資料
objRst_Add.AddNew
'設定各欄位的資料
objRst_Add("單號") = Right("0000" & Year(Date), 4) & _
Right("00" & Month(Date), 2) & _
Right("00" & Day(Date), 2) & _
Right("00" & Hour(Time), 2) & _
Right("00" & Minute(Time), 2) & _
Right("00" & Second(Time), 2)
objRst_Add("單據年") = Right("00" & Combo1.Text, 2)
objRst_Add("單據月") = Right("00" & Combo2.Text, 2)
objRst_Add("編號") = Trim(Text1.Text & "")
objRst_Add("姓名") = Trim(Text4.Text & "")
objRst_Add("處室") = Trim(Text5.Text & "")
objRst_Add("每小時金額") = Trim(Text2.Text & "")
objRst_Add("加班事由") = Trim(Text3.Text & "")
objRst_Add("加班開始日期") = Format(CDate(DTPicker1.Value), "yyyy/mm/dd")
objRst_Add("加班開始時間") = Format(TimeValue(DTPicker3.Value), "HH:MM")
objRst_Add("加班結束日期") = Format(CDate(DTPicker2.Value), "yyyy/mm/dd")
objRst_Add("加班結束時間") = Format(TimeValue(DTPicker4.Value), "HH:MM")
'取得新增項目的起始及結束日期時間
dtmStart_New = CDate(DTPicker1.Value) & " " & Format(TimeValue(DTPicker3.Value), "HH:MM")
dtmEnd_New = CDate(DTPicker2.Value) & " " & Format(TimeValue(DTPicker4.Value), "HH:MM")
'宣告計算時間所需要用到的變數
Dim str_HourMinute As String
Dim str_Hour As String
Dim str_Minute As String
Dim intI As Integer
'計算分鐘，起始日期到結束日期的時間差
str_HourMinute = FormatInterval(dtmStart_New, dtmEnd_New, "M:SS", 1028)
'取得小時
str_Hour = Int(Val(str_HourMinute) / 60)
'取得分鐘
str_Minute = Int(Val(str_HourMinute) Mod 60)
'設定新增的資料欄位
objRst_Add("加班共計小時") = str_Hour
objRst_Add("加班共計分鐘") = str_Minute
objRst_Add("填單日期") = Date & Time
'將資料更新
objRst_Add.Update
'關閉資料錄物件
objRst_Add.Close
'關閉資料庫連結物件
objCnn_ADD.Close
'釋放記憶體空間
Set objRst_Add = Nothing
Set objCnn_ADD = Nothing
'重新載入顯示資料
Call loadName
End Sub
'刪除按鈕被點選事件副程式
Private Sub Command2_Click()
'宣告刪除項目所需要的變數
Dim intI As Integer
Dim str_DeleteID As String
'初始化刪除字串
str_DeleteID = ""
'巡覽所有項目
For intI = 1 To ListView1.ListItems.Count
Debug.Print ListView1.ListItems(intI).Text
'當發現有被勾選刪除的項目時
If ListView1.ListItems(intI).Checked = True Then
'計錄刪除項目的代碼
str_DeleteID = str_DeleteID & ListView1.ListItems(intI).Text & ","
End If
Next intI
'當刪除項目代碼不存在時
If Len(str_DeleteID) <= 0 Then
'顯示訊息
labMessage.ForeColor = vbRed
labMessage.Caption = "訊息：請勾選要刪除的加班紀錄。"
Exit Sub
End If
'詢問是否要刪除
If MsgBox("請問是否確定要刪除呢？", vbYesNo, "訊問") = vbNo Then
Exit Sub
End If
'宣告刪除項目所需要用到的資料庫物件
Dim objCnn_Del As ADODB.Connection
Dim objRst_Del As ADODB.Recordset
'建立刪除項目所需要用到的資料庫物件
Set objCnn_Del = New ADODB.Connection
Set objRst_Del = New ADODB.Recordset
'開啟資料庫
objCnn_Del.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & App.Path & "\db1.mdb;" & _
"Persist Security Info=False"
'執行SQL命令，以代碼刪除資料項目
objCnn_Del.Execute "Delete From [資料表1] " & _
"Where [AID] In (" & Left(str_DeleteID, Len(str_DeleteID) - 1) & ")"
'關閉資料庫
objCnn_Del.Close
'釋放記憶體空間
Set objCnn_Del = Nothing
'重新載入資料
Call loadName
End Sub
'修改按鈕點選事件副程式
Private Sub Command3_Click()
'當項目為空時則跳離副程式
If ListView1.ListItems.Count <= 0 Then
Exit Sub
End If
'當選擇項目為空時則跳離副程式
If Len(ListView1.SelectedItem.Text) <= 0 Then
Exit Sub
End If
'當加班紀錄經過稽核後，就顯示不能修改的訊息，並跳離副程式
If Len(ListView1.SelectedItem.SubItems(11)) > 0 Then
labMessage.ForeColor = vbRed
labMessage.Caption = "訊息：經過稽核加班紀錄不可刪除或修改。"
Exit Sub
End If
'宣告要使用到的字串變數
Dim strRecord_A, strRecord_B, strRecord_C, strRecord_D, strRecord_E, _
strRecord_F, strRecord_G, strRecord_H, strRecord_I, strRecord_J, _
strRecord_K, strRecord_L As String
'判斷是否有輸入人員編號
If Len(Text1.Text) <= 0 Then
labMessage.ForeColor = vbRed
labMessage.Caption = "訊息：尚未輸入人員編號。"
Exit Sub
End If
'判斷是否有帶出人員姓名
If Len(Text4.Text) <= 0 Then
labMessage.ForeColor = vbRed
labMessage.Caption = "訊息：尚未帶出正確的人員姓名，請輸入正確的人員編號。"
Exit Sub
End If
'判斷是否有輸入加班事由
If Len(Text3.Text) <= 0 Then
labMessage.ForeColor = vbRed
labMessage.Caption = "訊息：尚未輸入加班事由。"
Exit Sub
End If
'判斷是否有輸入加班小時金額
If Len(Text2.Text) <= 0 Then
labMessage.ForeColor = vbRed
labMessage.Caption = "訊息：尚未輸入每小時金額。"
Exit Sub
End If
'要加入日期時間的輸入判斷，開始日期不可以大於結束日期
Dim dtmStart As Date
Dim dtmEnd As Date
'設定起始日期時間及結束日期時間
dtmStart = CDate(DTPicker1.Value) & TimeValue(DTPicker3.Value)
dtmEnd = CDate(DTPicker2.Value) & TimeValue(DTPicker4.Value)
'判斷起始日期時間是否大於結束日期時間
If dtmStart >= dtmEnd Then
labMessage.ForeColor = vbRed
labMessage.Caption = "訊息：輸入的日期時間不正確。"
Exit Sub
End If
'判斷日期時間是否有重疊
Dim lngI As Long
Dim str_DontAdd As String
'清除通過旗標
str_DontAdd = ""
'初始化計數器
lngI = 0
'巡覽所有加班項目
For lngI = 1 To ListView1.ListItems.Count
'設定顏色
ListView1.ListItems(lngI).ListSubItems(2).ForeColor = vbBlack
'略過要修改的項目
If Trim(ListView1.ListItems(lngI).Text & "") <> Trim(ListView1.SelectedItem.Text & "") Then
'宣告必須使用的變數
Dim lng_DateTimeRange_Record As Long
Dim lng_DateTimeRange_New As Long
Dim lng_DateTimeRange_Max As Long
Dim dtmStart_Record As Date
Dim dtmEnd_Record As Date
Dim dtmStart_New As Date
Dim dtmEnd_New As Date
Dim dtmStart_Max As Date
Dim dtmEnd_Max As Date
'設定該列加班項目的起始日期時間與結束日期時間
dtmStart_Record = CDate(ListView1.ListItems(lngI).SubItems(4)) & TimeValue(ListView1.ListItems(lngI).SubItems(5))
dtmEnd_Record = CDate(ListView1.ListItems(lngI).SubItems(6)) & TimeValue(ListView1.ListItems(lngI).SubItems(7))
'計算加班日期時間範圍
lng_DateTimeRange_Record = Val(FormatInterval(dtmStart_Record, dtmEnd_Record, "M:SS", 1028))
'設定新增的加班起始日期時間與結束日期時間
dtmStart_New = CDate(DTPicker1.Value) & " " & Format(TimeValue(DTPicker3.Value), "HH:MM")
dtmEnd_New = CDate(DTPicker2.Value) & " " & Format(TimeValue(DTPicker4.Value), "HH:MM")
'計算新增的加班日期時間範圍
lng_DateTimeRange_New = Val(FormatInterval(dtmStart_New, dtmEnd_New, "M:SS", 1028))
'設定最大起始日期時間
dtmStart_Max = dtmStart_New
If dtmStart_Record <= dtmStart_New Then
dtmStart_Max = dtmStart_Record
End If
'設定最大結束日期時間
dtmEnd_Max = dtmEnd_New
If dtmEnd_Record >= dtmEnd_New Then
dtmEnd_Max = dtmEnd_Record
End If
'計算最大起始與結束日期時間範圍
lng_DateTimeRange_Max = Val(FormatInterval(dtmStart_Max, dtmEnd_Max, "M:SS", 1028))
'倘若最大時間範圍減去已紀錄的時間範圍並加上新的時間範圍，計算結果若小於等於零時
If lng_DateTimeRange_Max - (lng_DateTimeRange_Record + lng_DateTimeRange_New) <= 0 Then
'設定顏色提醒
ListView1.ListItems(lngI).ListSubItems(2).ForeColor = vbRed
ListView1.Refresh
'顯示訊息
labMessage.ForeColor = vbRed
labMessage.Caption = "訊息：加班時間有重疊。"
'設定加班項目有誤旗標
str_DontAdd = "Yes"
End If
End If
Next lngI
'倘若新增的加班項目有誤，則跳離副程式
If str_DontAdd = "Yes" Then
Exit Sub
End If
'通過檢查，開始紀錄資料
ListView1.Refresh
'重設訊息
labMessage.ForeColor = vbBlack
labMessage.Caption = "訊息："
'設定各欄位的紀錄變數
strRecord_A = Trim(Combo1.Text & "")
strRecord_B = Trim(Combo2.Text & "")
strRecord_C = Trim(Text1.Text & "")
strRecord_D = Trim(Text4.Text & "")
strRecord_E = Trim(Text3.Text & "")
strRecord_F = DTPicker1.Value
strRecord_G = DTPicker3.Value
strRecord_I = DTPicker2.Value
strRecord_J = DTPicker4.Value
strRecord_K = Trim(Text2.Text & "")
'宣告更新的項目必須使用到的物件及變數
Dim objCnn_ADD As ADODB.Connection
Dim objRst_Add As ADODB.Recordset
Dim strSQL As String
'建立更新項目必須使用到的資料庫物件
Set objCnn_ADD = New ADODB.Connection
Set objRst_Add = New ADODB.Recordset
'設定連結資料庫的命令文字
strSQL = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & App.Path & "\db1.mdb" & ";" & _
"Mode=Read|Write|Share Deny None;" & _
"Persist Security Info=False;"
'開啟資料庫
objCnn_ADD.Open strSQL
'設定SQL命令文字
strSQL = "Select * From [資料表1] Where [AID] Like '" & Trim(ListView1.SelectedItem.Text) & "'"
'開啟資料錄
objRst_Add.Open strSQL, objCnn_ADD, adOpenStatic, adLockPessimistic
'找到要備更新的資料項目
If objRst_Add.RecordCount = 1 Then
'假設尚未被稽核
If Len(Trim(objRst_Add("稽核者") & "")) <= 0 Then
'設定各欄位的資料
objRst_Add("單號") = Right("0000" & Year(Date), 4) & _
Right("00" & Month(Date), 2) & _
Right("00" & Day(Date), 2) & _
Right("00" & Hour(Time), 2) & _
Right("00" & Minute(Time), 2) & _
Right("00" & Second(Time), 2)
objRst_Add("單據年") = Right("00" & Combo1.Text, 2)
objRst_Add("單據月") = Right("00" & Combo2.Text, 2)
objRst_Add("編號") = Trim(Text1.Text & "")
objRst_Add("姓名") = Trim(Text4.Text & "")
objRst_Add("處室") = Trim(Text5.Text & "")
objRst_Add("每小時金額") = Trim(Text2.Text & "")
objRst_Add("加班事由") = Trim(Text3.Text & "")
objRst_Add("加班開始日期") = Format(CDate(DTPicker1.Value), "yyyy/mm/dd")
objRst_Add("加班開始時間") = Format(TimeValue(DTPicker3.Value), "HH:MM")
objRst_Add("加班結束日期") = Format(CDate(DTPicker2.Value), "yyyy/mm/dd")
objRst_Add("加班結束時間") = Format(TimeValue(DTPicker4.Value), "HH:MM")
'取得更新項目的起始及結束日期時間
dtmStart_New = CDate(DTPicker1.Value) & " " & Format(TimeValue(DTPicker3.Value), "HH:MM")
dtmEnd_New = CDate(DTPicker2.Value) & " " & Format(TimeValue(DTPicker4.Value), "HH:MM")
'宣告計算時間所需要用到的變數
Dim str_HourMinute As String
Dim str_Hour As String
Dim str_Minute As String
Dim intI As Integer
'計算分鐘，起始日期到結束日期的時間差
str_HourMinute = FormatInterval(dtmStart_New, dtmEnd_New, "M:SS", 1028)
'取得小時
str_Hour = Int(Val(str_HourMinute) / 60)
'取得分鐘
str_Minute = Int(Val(str_HourMinute) Mod 60)
'設定更新的資料欄位
objRst_Add("加班共計小時") = str_Hour
objRst_Add("加班共計分鐘") = str_Minute
objRst_Add("填單日期") = Date & Time
'執行更新
objRst_Add.Update
End If
End If
'關閉資料錄
objRst_Add.Close
'關閉資料庫
objCnn_ADD.Close
'釋放記憶體空間
Set objRst_Add = Nothing
Set objCnn_ADD = Nothing
'重新針對更新項目做資料載入
Call loadName(Trim(ListView1.SelectedItem.Text))
End Sub
'勾選加班資料項目事件副程式
Private Sub ListView1_ItemCheck(ByVal Item As MSComctlLib.ListItem)
'判斷勾選到已經被稽核過的項目
If Len(Item.SubItems(11)) > 0 Then
'設定取消勾選
Item.Checked = False
'顯示提示訊息
labMessage.ForeColor = vbRed
labMessage.Caption = "訊息：經過稽核加班紀錄不可刪除或修改。"
'跳離副程式
Exit Sub
End If
End Sub
'當加班項目被點選事件副程式
Private Sub ListView1_ItemClick(ByVal Item As MSComctlLib.ListItem)
'由清單取得各項資料
Text3.Text = Trim(Item.SubItems(1) & "")
DTPicker1.Value = CDate(Item.SubItems(4))
DTPicker2.Value = CDate(Item.SubItems(6))
DTPicker3.Value = CDate(Item.SubItems(5))
DTPicker4.Value = CDate(Item.SubItems(7))
Text2.Text = Trim(Item.SubItems(10) & "")
End Sub
'人員編號按鍵放開事件副程式
Private Sub Text1_KeyUp(KeyCode As Integer, Shift As Integer)
'重新找尋資料
Call loadName
End Sub
'每小時加班時薪輸入文字框事件副程式
Private Sub Text2_KeyPress(KeyAscii As Integer)
'只允許輸入數字
If KeyAscii < 48 Or KeyAscii > 57 Then
KeyAscii = 0
End If
End Sub
'姓名輸入文字框事件副程式
Private Sub Text4_KeyPress(KeyAscii As Integer)
'不允許任何字元輸入
KeyAscii = 0
End Sub
'重新設定控制項資料副程式
Public Sub Reload()
'設定年度下拉式選單項目
Combo1.AddItem "93", 0
Combo1.AddItem "94", 1
Combo1.AddItem "95", 2
Combo1.AddItem "96", 3
Combo1.AddItem "97", 4
Combo1.AddItem "98", 5
Combo1.AddItem "99", 6
Combo1.ListIndex = 0
'設定月份下拉式選單項目
Combo2.AddItem "01", 0
Combo2.AddItem "02", 1
Combo2.AddItem "03", 2
Combo2.AddItem "04", 3
Combo2.AddItem "05", 4
Combo2.AddItem "06", 5
Combo2.AddItem "07", 6
Combo2.AddItem "08", 7
Combo2.AddItem "09", 8
Combo2.AddItem "10", 9
Combo2.AddItem "11", 10
Combo2.AddItem "12", 11
Combo2.ListIndex = Val(Month(Date)) - 1
'設定日期控制項數值
DTPicker1.Value = Date
DTPicker2.Value = Date
DTPicker3.Value = Time
DTPicker4.Value = Time
'設定背景圖型大小及位置
Shape2.Left = 0
Shape2.Width = UserControl.Width
'清除文字輸入框
Text1.Text = ""
Text4.Text = ""
Text5.Text = ""
'清除訊息
labMessage.Caption = ""
labMM_Hour.Caption = ""
labMM_Minute.Caption = ""
'清空清單
ListView1.ListItems.Clear
End Sub
'載入資料副程式
Private Sub loadName(Optional strListPoint As String)
'開啟資料錄，以人員代號找尋相關資料
objRst.Open "select * from [資料表2] " & _
"where [UID] like '" & Text1.Text & "'", _
objCnn, adOpenStatic, adLockPessimistic
'當有資料時
If objRst.RecordCount > 0 Then
'設定文字框資料
Text4.Text = objRst("UNAME")
Text5.Text = objRst("UGROUP")
'當有資料時
If Len(Text1.Text) > 0 And Len(Text4.Text) > 0 Then
'呼叫函式帶出相關資料
Call A(strListPoint)
End If
反之
Else
'清除文字框及清單
Text4.Text = ""
Text5.Text = ""
ListView1.ListItems.Clear
End If
'關閉資料錄
objRst.Close
End Sub
'加班資料載入副程式
Private Sub A(Optional strListPoint As String)
'宣告資料庫必需的物件
Dim objCnn_A As ADODB.Connection
Dim objRst_A As ADODB.Recordset
'宣告清單項目物件
Dim objItem As ListItem
'宣告總時數長整數變數
Dim lng_TotalHour As Long
'宣告總分鐘長整數變數
Dim lng_TotalMinute As Long
'建立資料庫必須物件
Set objCnn_A = New ADODB.Connection
Set objRst_A = New ADODB.Recordset
'開啟資料庫
objCnn_A.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & App.Path & "\db1.mdb;" & _
"Persist Security Info=False"
'開啟資料錄，找尋相關加班單資料
objRst_A.Open "select * from [資料表1] where " & _
"[單據年] like '" & Trim(Combo1.Text & "") & "' And " & _
"[單據月] like '" & Trim(Combo2.Text & "") & "' And " & _
"[編號] like '" & Trim(Text1.Text & "") & "' And " & _
"[姓名] like '" & Trim(Text4.Text & "") & "'", _
objCnn_A, adOpenStatic, adLockPessimistic
'清除清單項目
ListView1.ListItems.Clear
'巡覽所有加班單資料
Do Until objRst_A.EOF
'新增加班單資料項目
Set objItem = ListView1.ListItems.Add(, , Trim(objRst_A("AID") & ""))
objItem.SubItems(1) = Trim(objRst_A("加班事由") & "")
objItem.SubItems(2) = Trim(objRst_A("加班開始日期") & "") & " " & Trim(objRst_A("加班開始時間") & "") & " ~ " & _
Trim(objRst_A("加班結束日期") & "") & " " & Trim(objRst_A("加班結束時間") & "")
objItem.SubItems(3) = Trim(objRst_A("加班共計小時") & "") & "小時" & Trim(objRst_A("加班共計分鐘") & "") & "分鐘"
objItem.SubItems(4) = Trim(objRst_A("加班開始日期") & "")
objItem.SubItems(5) = Trim(objRst_A("加班開始時間") & "")
objItem.SubItems(6) = Trim(objRst_A("加班結束日期") & "")
objItem.SubItems(7) = Trim(objRst_A("加班結束時間") & "")
objItem.SubItems(8) = Trim(objRst_A("加班共計小時") & "")
objItem.SubItems(9) = Trim(objRst_A("加班共計分鐘") & "")
objItem.SubItems(10) = Trim(objRst_A("每小時金額") & "")
objItem.SubItems(11) = Trim(objRst_A("稽核者") & "")
objItem.SubItems(12) = Trim(objRst_A("稽核日期") & "")
'設定顏色
objItem.ListSubItems(2).ForeColor = vbBlack
'計算總時數
lng_TotalHour = lng_TotalHour + Val(Trim(objRst_A("加班共計小時") & ""))
'計算總分鐘
lng_TotalMinute = lng_TotalMinute + Val(Trim(objRst_A("加班共計分鐘") & ""))
'將資料錄移動到下一筆
objRst_A.MoveNext
Loop
'關閉資料錄
objRst_A.Close
'關閉資料庫
objCnn_A.Close
'釋放記憶體空間
Set objRst_A = Nothing
Set objCnn_A = Nothing
'宣告計數變數
Dim lngI As Long
'巡覽所有清單項目
For lngI = 1 To ListView1.ListItems.Count
'當有項目已經被稽核過了
If Len(ListView1.ListItems(lngI).SubItems(11)) > 0 Then
'設定項目顏色
ListView1.ListItems(lngI).ForeColor = vbBlue
ListView1.ListItems(lngI).ListSubItems(1).ForeColor = vbBlue
ListView1.ListItems(lngI).ListSubItems(2).ForeColor = vbBlue
ListView1.ListItems(lngI).ListSubItems(3).ForeColor = vbBlue
ListView1.ListItems(lngI).ListSubItems(4).ForeColor = vbBlue
ListView1.ListItems(lngI).ListSubItems(5).ForeColor = vbBlue
ListView1.ListItems(lngI).ListSubItems(6).ForeColor = vbBlue
ListView1.ListItems(lngI).ListSubItems(7).ForeColor = vbBlue
ListView1.ListItems(lngI).ListSubItems(8).ForeColor = vbBlue
ListView1.ListItems(lngI).ListSubItems(9).ForeColor = vbBlue
ListView1.ListItems(lngI).ListSubItems(10).ForeColor = vbBlue
ListView1.ListItems(lngI).ListSubItems(11).ForeColor = vbBlue
ListView1.ListItems(lngI).ListSubItems(12).ForeColor = vbBlue
End If
Next lngI
'顯示小時
labMM_Hour.Caption = lng_TotalHour + Int(lng_TotalMinute / 60)
'顯示分鐘
labMM_Minute.Caption = Int(lng_TotalMinute Mod 60)
'設定尋找項目
Set objItem = ListView1.FindItem(strListPoint, 0, , 1)
'當找到項目時
If Not (objItem Is Nothing) Then
'設定選擇
objItem.Selected = True
'展開項目
objItem.EnsureVisible
End If
End Sub
'使用者自訂控制項大小調整事件副程式
Private Sub UserControl_Resize()
'重設大小及位置
Shape2.Left = 0
Shape2.Width = UserControl.Width
End Sub
'使用者自訂控制項結束
Private Sub UserControl_Terminate()
'關閉資料庫
objCnn.Close
'釋放記憶體空間
Set objCnn = Nothing
End Sub
2.6.3 加班時間稽核表之控制項設計¶
Step 1：這是加班單稽核的控制項。請參考如圖2-3的版面配置。
圖 2‑3 加班時間稽核單之介面配置
Step 2：請加以下程式碼加入使用者自訂控制項中。
'設定所有變數必須宣告才能使用
Option Explicit
'宣告ADO資料庫連結物件
Dim objCnn As ADODB.Connection
'宣告ADO資料錄物件
Dim objRst As ADODB.Recordset
'宣告清單項目物件
Dim objItem As ListItem
'加班時間表使用者自訂控制項初始化事件副程式
Private Sub UserControl_Initialize()
'設定ADO資料庫連結物件
Set objCnn = New ADODB.Connection
'開啟資料庫
objCnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & App.Path & "\db1.mdb;" & _
"Persist Security Info=False"
'設定ADO資料錄物件
Set objRst = New ADODB.Recordset
'設定年度下拉式選單項目，您也可以採用迴圈的方式新增
Combo1.AddItem "93", 0
Combo1.AddItem "94", 1
Combo1.AddItem "95", 2
Combo1.AddItem "96", 3
Combo1.AddItem "97", 4
Combo1.AddItem "98", 5
Combo1.AddItem "99", 6
Combo1.ListIndex = 0
'設定月份下拉式選單項目，您也可以採用迴圈的方式新增
Combo2.AddItem "01", 0
Combo2.AddItem "02", 1
Combo2.AddItem "03", 2
Combo2.AddItem "04", 3
Combo2.AddItem "05", 4
Combo2.AddItem "06", 5
Combo2.AddItem "07", 6
Combo2.AddItem "08", 7
Combo2.AddItem "09", 8
Combo2.AddItem "10", 9
Combo2.AddItem "11", 10
Combo2.AddItem "12", 11
Combo2.ListIndex = Val(Month(Date)) - 1
'設定背景圖型大小及位置
Shape1.Left = 0
Shape1.Width = UserControl.Width
End Sub
'年度下拉式選單點選事件副程式
Private Sub Combo1_Click()
'重新載入資料
Call loadName
End Sub
'月份下拉式選單點選事件副程式
Private Sub Combo2_Click()
'重新載入資料
Call loadName
End Sub
'批次稽核按鈕點選事件副程式
Private Sub Command1_Click()
'宣告計數長整數變數
Dim lngI As Long
'宣告代碼字串變數
Dim str_Add As String
'初始化變數
str_Add = ""
lngI = 0
'巡覽所有清單項目
For lngI = 1 To ListView1.ListItems.Count
'當發現有資料被核取時
If ListView1.ListItems(lngI).Checked = True Then
'將代碼加入字串
str_Add = str_Add & ListView1.ListItems(lngI).Text & ","
End If
Next lngI
'當發現沒有勾選時
If Len(str_Add) <= 0 Then
'顯示提示訊息
labMessage.ForeColor = vbRed
labMessage.Caption = "訊息：請勾選要稽核的紀錄。"
'跳離副程式
Exit Sub
End If
'宣告ADO資料庫連結物件
Dim objCnn_ADD As ADODB.Connection
'宣告ADO資料錄物件
Dim objRst_Add As ADODB.Recordset
'宣告字串變數
Dim strSQL As String
'建立ADO資料庫連結物件
Set objCnn_ADD = New ADODB.Connection
'建立ADO資料錄物件
Set objRst_Add = New ADODB.Recordset
'設定資料庫連結命令文字
strSQL = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & App.Path & "\db1.mdb" & ";" & _
"Mode=Read|Write|Share Deny None;" & _
"Persist Security Info=False;"
'開啟資料庫
objCnn_ADD.Open strSQL
'設定尋找代碼SQL命令文字
strSQL = "Select * From [資料表1] where [AID] in (" & Left(str_Add, Len(str_Add) - 1) & ")"
'開啟資料錄
objRst_Add.Open strSQL, objCnn_ADD, adOpenStatic, adLockPessimistic
'巡覽所有資料錄
Do Until objRst_Add.EOF = True
'設定稽核資料
objRst_Add("稽核者") = "稽核者"
objRst_Add("稽核日期") = Date & Time
'更新稽核資料
objRst_Add.Update
'移動到下一筆資料
objRst_Add.MoveNext
Loop
'關閉資料錄
objRst_Add.Close
'關閉資料庫
objCnn_ADD.Close
'釋放記憶體空間
Set objRst_Add = Nothing
Set objCnn_ADD = Nothing
'重新載入資料
Call loadName
End Sub
'批次取消按鈕點選事件副程式
Private Sub Command2_Click()
'宣告計數整數變數
Dim intI As Integer
'宣告代碼字串變數
Dim str_DeleteID As String
'初始化變數
str_DeleteID = ""
'巡覽所有清單項目
For intI = 1 To ListView1.ListItems.Count
'當發現有項目被選取
If ListView1.ListItems(intI).Checked = True Then
'將項目代碼加入字串
str_DeleteID = str_DeleteID & ListView1.ListItems(intI).Text & ","
End If
Next intI
'當發現沒有勾選
If Len(str_DeleteID) <= 0 Then
'顯示提示訊息
labMessage.ForeColor = vbRed
labMessage.Caption = "訊息：請勾選要取消稽核的紀錄。"
'跳離副程式
Exit Sub
End If
'詢問是否要清空稽核
If MsgBox("請問是否確定要清空稽核呢？", vbYesNo, "詢問") = vbNo Then
Exit Sub
End If
'宣告ADO資料庫連結物件
Dim objCnn_Del As ADODB.Connection
'宣告ADO資料錄物件
Dim objRst_Del As ADODB.Recordset
'設定ADO資料庫連結物件
Set objCnn_Del = New ADODB.Connection
'設定ADO資料錄物件
Set objRst_Del = New ADODB.Recordset
'開啟資料庫
objCnn_Del.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & App.Path & "\db1.mdb;" & _
"Persist Security Info=False"
'更新稽核取消資料
objCnn_Del.Execute "Update [資料表1] " & _
"Set [稽核者] = '' , " & _
"[稽核日期] = '' " & _
"Where [AID] In (" & Left(str_DeleteID, Len(str_DeleteID) - 1) & ")"
'關閉資料庫
objCnn_Del.Close
'釋放記憶體空間
Set objCnn_Del = Nothing
'重新載入資料
Call loadName
End Sub
'人員代碼輸入文字框按鍵放開事件副程式
Private Sub Text1_KeyUp(KeyCode As Integer, Shift As Integer)
'重新載入資料
Call loadName
End Sub
'人員姓名文字框按鍵事件副程式
Private Sub Text4_KeyPress(KeyAscii As Integer)
'禁止所有按鍵輸入
KeyAscii = 0
End Sub
'資料重新初始化副程式
Public Sub Reload()
'設定年度下拉式選單項目，您也可以採用迴圈的方式新增
Combo1.AddItem "93", 0
Combo1.AddItem "94", 1
Combo1.AddItem "95", 2
Combo1.AddItem "96", 3
Combo1.AddItem "97", 4
Combo1.AddItem "98", 5
Combo1.AddItem "99", 6
Combo1.ListIndex = 0
'設定月份下拉式選單項目，您也可以採用迴圈的方式新增
Combo2.AddItem "01", 0
Combo2.AddItem "02", 1
Combo2.AddItem "03", 2
Combo2.AddItem "04", 3
Combo2.AddItem "05", 4
Combo2.AddItem "06", 5
Combo2.AddItem "07", 6
Combo2.AddItem "08", 7
Combo2.AddItem "09", 8
Combo2.AddItem "10", 9
Combo2.AddItem "11", 10
Combo2.AddItem "12", 11
Combo2.ListIndex = Val(Month(Date)) - 1
'設定背景圖型大小及位置
Shape1.Left = 0
Shape1.Width = UserControl.Width
'清空文字
Text1.Text = ""
Text4.Text = ""
Text5.Text = ""
'清空訊息
labMessage.Caption = ""
'清空清單
ListView1.ListItems.Clear
End Sub
'載入資料副程式
Private Sub loadName()
'開啟資料錄
objRst.Open "select * from [資料表2] " & _
"where [UID] like '" & Text1.Text & "'", _
objCnn, adOpenStatic, adLockPessimistic
'當發現有資料時
If objRst.RecordCount > 0 Then
'設定人員姓名
Text4.Text = objRst("UNAME")
'設定群組名稱
Text5.Text = objRst("UGROUP")
'當有人員姓名與群組名稱時
If Len(Text1.Text) > 0 And Len(Text4.Text) > 0 Then
'呼叫載入加班資料清單副程式
Call A
End If
Else
'清除文字
Text4.Text = ""
Text5.Text = ""
'清除清單
ListView1.ListItems.Clear
End If
關閉資料錄
objRst.Close
End Sub
'載入加班資料清單副程式
Private Sub A()
'宣告ADO資料庫連結物件
Dim objCnn_A As ADODB.Connection
'宣告ADO資料錄物件
Dim objRst_A As ADODB.Recordset
'宣告清單項目物件
Dim objItem As ListItem
'宣告小時計數變數
Dim lng_TotalHour As Long
'宣告分鐘計數變數
Dim lng_TotalMinute As Long
'建立ADO資料庫連結物件
Set objCnn_A = New ADODB.Connection
'建立ADO資料錄物件
Set objRst_A = New ADODB.Recordset
'開啟資料庫
objCnn_A.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & App.Path & "\db1.mdb;" & _
"Persist Security Info=False"
'開啟資料錄
objRst_A.Open "select * from [資料表1] where " & _
"[單據年] like '" & Trim(Combo1.Text & "") & "' And " & _
"[單據月] like '" & Trim(Combo2.Text & "") & "' And " & _
"[編號] like '" & Trim(Text1.Text & "") & "' And " & _
"[姓名] like '" & Trim(Text4.Text & "") & "'", _
objCnn_A, adOpenStatic, adLockPessimistic
'清空清單項目
ListView1.ListItems.Clear
'巡覽所有資料錄
Do Until objRst_A.EOF
'設定增加清單項目
Set objItem = ListView1.ListItems.Add(, , Trim(objRst_A("AID") & ""))
objItem.SubItems(1) = Trim(objRst_A("加班事由") & "")
objItem.SubItems(2) = Trim(objRst_A("加班開始日期") & "") & " " & Trim(objRst_A("加班開始時間") & "") & " ~ " & _
Trim(objRst_A("加班結束日期") & "") & " " & Trim(objRst_A("加班結束時間") & "")
objItem.SubItems(3) = Trim(objRst_A("加班共計小時") & "") & "小時" & Trim(objRst_A("加班共計分鐘") & "") & "分鐘"
objItem.SubItems(4) = Trim(objRst_A("加班開始日期") & "")
objItem.SubItems(5) = Trim(objRst_A("加班開始時間") & "")
objItem.SubItems(6) = Trim(objRst_A("加班結束日期") & "")
objItem.SubItems(7) = Trim(objRst_A("加班結束時間") & "")
objItem.SubItems(8) = Trim(objRst_A("加班共計小時") & "")
objItem.SubItems(9) = Trim(objRst_A("加班共計分鐘") & "")
objItem.SubItems(10) = Trim(objRst_A("每小時金額") & "")
objItem.SubItems(11) = Trim(objRst_A("稽核者") & "")
objItem.SubItems(12) = Trim(objRst_A("稽核日期") & "")
'設定顏色
objItem.ListSubItems(2).ForeColor = vbBlack
'統計所有加班小時
lng_TotalHour = lng_TotalHour + Val(Trim(objRst_A("加班共計小時") & ""))
'統計所有加班分鐘
lng_TotalMinute = lng_TotalMinute + Val(Trim(objRst_A("加班共計分鐘") & ""))
'移動資料錄到下一筆
objRst_A.MoveNext
Loop
'關閉資料錄
objRst_A.Close
'關閉資料庫
objCnn_A.Close
'釋放記憶體空間
Set objRst_A = Nothing
Set objCnn_A = Nothing
'宣告計數變數
Dim lngI As Long
'巡覽所有清單項目
For lngI = 1 To ListView1.ListItems.Count
'當發現有資料被稽核過
If Len(ListView1.ListItems(lngI).SubItems(11)) > 0 Then
'設定顏色
ListView1.ListItems(lngI).ForeColor = vbBlue
ListView1.ListItems(lngI).ListSubItems(1).ForeColor = vbBlue
ListView1.ListItems(lngI).ListSubItems(2).ForeColor = vbBlue
ListView1.ListItems(lngI).ListSubItems(3).ForeColor = vbBlue
ListView1.ListItems(lngI).ListSubItems(4).ForeColor = vbBlue
ListView1.ListItems(lngI).ListSubItems(5).ForeColor = vbBlue
ListView1.ListItems(lngI).ListSubItems(6).ForeColor = vbBlue
ListView1.ListItems(lngI).ListSubItems(7).ForeColor = vbBlue
ListView1.ListItems(lngI).ListSubItems(8).ForeColor = vbBlue
ListView1.ListItems(lngI).ListSubItems(9).ForeColor = vbBlue
ListView1.ListItems(lngI).ListSubItems(10).ForeColor = vbBlue
ListView1.ListItems(lngI).ListSubItems(11).ForeColor = vbBlue
ListView1.ListItems(lngI).ListSubItems(12).ForeColor = vbBlue
End If
Next lngI
End Sub
'加班時間稽核單自訂控制項大小改變事件副程式
Private Sub UserControl_Resize()
'重新設定背景圖型大小及位置
Shape1.Left = 0
Shape1.Width = UserControl.Width
End Sub
'加班時間稽核單自訂控制項結束事件副程式
Private Sub UserControl_Terminate()
'關閉資料庫
objCnn.Close
'釋放記憶體空間
Set objCnn = Nothing
End Sub
2.6.4 加班時間統計表之控制項設計¶
Step 1：這是加班單統計的控制項。請參考如圖2-4的版面配置。
圖 2‑4 加班時間統計表之介面配置
Step 2：請加以下程式碼加入使用者自訂控制項中。
'設定所有變數必須宣告才能使用
Option Explicit
'宣告ADO資料庫連結物件
Dim objCnn As ADODB.Connection
'宣告ADO資料錄物件
Dim objRst As ADODB.Recordset
'宣告清單項目物件
Dim objItem As ListItem
'加班時間統計單自訂使用者控制項初始化事件副程式
Private Sub UserControl_Initialize()
'建立資料庫連結物件
Set objCnn = New ADODB.Connection
'開啟資料庫
objCnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & App.Path & "\db1.mdb;" & _
"Persist Security Info=False"
'建立資料錄物件
Set objRst = New ADODB.Recordset
'設定起始日數值
DTPicker1.Value = Year(Date) & "/" & Month(Date) & "/1"
'利用IsDate判斷該月份最後一日
If IsDate(Year(Date) & "/" & Month(Date) & "/31") = False Then
DTPicker2.Value = Year(Date) & "/" & Month(Date) & "/30"
If IsDate(Year(Date) & "/" & Month(Date) & "/30") = False Then
DTPicker2.Value = Year(Date) & "/" & Month(Date) & "/29"
If IsDate(Year(Date) & "/" & Month(Date) & "/29") = False Then
DTPicker2.Value = Year(Date) & "/" & Month(Date) & "/28"
End If
End If
Else
DTPicker2.Value = Year(Date) & "/" & Month(Date) & "/31"
End If
'增加處室下拉式選單項目
Combo4.AddItem "不統計", 0
Combo4.ListIndex = 0
'設定背景圖形大小及位置
Shape1.Left = 0
Shape1.Width = UserControl.Width
'呼叫載入處室資料到下拉是清單副程式
Call B
End Sub
'處室下拉是清單點選事件副程式
Private Sub Combo4_Click()
'清除文字框
Text1.Text = ""
Text1.BackColor = &HFFC0C0
Text1.Enabled = False
Text4.Text = ""
'清除訊息
labMM_Money.Caption = ""
labMM_Hour.Caption = ""
labMM_Minute.Caption = ""
labMessage.Caption = ""
'清除清單
ListView1.ListItems.Clear
'當選擇到不統計時
If Trim(Combo4.Text & "") = "不統計" Then
'清除文字框
Text1.Text = ""
Text1.BackColor = &HFFFFFF
Text1.Enabled = True
Text4.Text = ""
'清除訊息
labMM_Money.Caption = ""
labMM_Hour.Caption = ""
labMM_Minute.Caption = ""
labMessage.Caption = ""
'反之
Else
'載入清單資料
Call loadName
End If
End Sub
'開始統計按鈕點選事件副程式
Private Sub Command1_Click()
'當選擇不統計時
If Len(Text1.Text) <= 0 And Combo4.Text = "不統計" Then
'顯示訊息
labMessage.ForeColor = vbRed
labMessage.Caption = "訊息：請選擇要統計的人或處室。"
'跳離副程式
Exit Sub
End If
'當清單無資料時
If ListView1.ListItems.Count <= 0 Then
'顯示訊息
labMessage.ForeColor = vbRed
labMessage.Caption = "訊息：無加班紀錄，無法統計。"
'跳離副程式
Exit Sub
End If
'宣告計數變數
Dim lngI As Long
'宣告金額變數
Dim cuy_Money As Currency
'宣告小時變數
Dim lng_Hour As Long
'宣告分鐘變數
Dim lng_Minute As Long
'初始化變數
cuy_Money = 0
lngI = 0
'巡覽所有清單項目
For lngI = 1 To ListView1.ListItems.Count
'當選擇一：超過半小時，計算．(四捨五入)
If Option1.Value = True Then
'累加金額
cuy_Money = cuy_Money + _
(Val(ListView1.ListItems(lngI).SubItems(8)) * Val(ListView1.ListItems(lngI).SubItems(10)))
'當選擇二：不滿一小時，不計．(無條件捨去)
ElseIf Option2.Value = True Then
'累加金額
cuy_Money = cuy_Money + _
(Val(ListView1.ListItems(lngI).SubItems(8)) * Val(ListView1.ListItems(lngI).SubItems(10)))
'當分鐘超過三十
If Val(ListView1.ListItems(lngI).SubItems(9)) >= 30 Then
'累加金額
cuy_Money = cuy_Money + Val(ListView1.ListItems(lngI).SubItems(10))
End If
'當選擇三：計算分薪．(百分比，小數點四捨五入)
ElseIf Option3.Value = True Then
'累加金額
cuy_Money = cuy_Money + _
(Val(ListView1.ListItems(lngI).SubItems(8)) * Val(ListView1.ListItems(lngI).SubItems(10)))
'當分鐘超過三十
If Val(ListView1.ListItems(lngI).SubItems(9)) >= 30 Then
'累加金額
cuy_Money = cuy_Money + _
Round((Val(ListView1.ListItems(lngI).SubItems(9)) / 60) * Val(ListView1.ListItems(lngI).SubItems(10)))
End If
End If
'累計小時
lng_Hour = lng_Hour + Val(ListView1.ListItems(lngI).SubItems(8))
'累計分鐘
lng_Minute = lng_Minute + Val(ListView1.ListItems(lngI).SubItems(9))
Next lngI
'計算小時
lng_Hour = lng_Hour + (lng_Minute \ 60)
'計算分鐘
lng_Minute = lng_Minute Mod 60
'顯示訊息
labMM_Money.Caption = Format(cuy_Money, "#,###")
labMM_Hour.Caption = lng_Hour
labMM_Minute.Caption = lng_Minute
End Sub
'起始日期改變事件副程式
Private Sub DTPicker1_Change()
'清空統計訊息
labMM_Money.Caption = ""
labMM_Hour.Caption = ""
labMM_Minute.Caption = ""
labMessage.Caption = ""
'重新載入資料
Call loadName
End Sub
'結束日期改變事件副程式
Private Sub DTPicker2_Change()
'清空統計訊息
labMM_Money.Caption = ""
labMM_Hour.Caption = ""
labMM_Minute.Caption = ""
labMessage.Caption = ""
'重新載入資料
Call loadName
End Sub
'代碼文字輸入框按鍵放開事件副程式
Private Sub Text1_KeyUp(KeyCode As Integer, Shift As Integer)
'設定處室選項為不統計
Combo4.ListIndex = 0
'清空統計訊息
labMM_Money.Caption = ""
labMM_Hour.Caption = ""
labMM_Minute.Caption = ""
labMessage.Caption = ""
'重新載入資料
Call loadName
End Sub
'姓名文字輸入事件副程式
Private Sub Text4_KeyPress(KeyAscii As Integer)
'禁止所有字元輸入
KeyAscii = 0
End Sub
'重新載入初始化資料副程式
Public Sub Reload()
'設定起始日期數值
DTPicker1.Value = Year(Date) & "/" & Month(Date) & "/1"
'藉由IsDate函是判斷該月份的最後一日
If IsDate(Year(Date) & "/" & Month(Date) & "/31") = False Then
DTPicker2.Value = Year(Date) & "/" & Month(Date) & "/30"
If IsDate(Year(Date) & "/" & Month(Date) & "/30") = False Then
DTPicker2.Value = Year(Date) & "/" & Month(Date) & "/29"
If IsDate(Year(Date) & "/" & Month(Date) & "/29") = False Then
DTPicker2.Value = Year(Date) & "/" & Month(Date) & "/28"
End If
End If
Else
DTPicker2.Value = Year(Date) & "/" & Month(Date) & "/31"
End If
'新增處室下拉式選單項目
Combo4.AddItem "不統計", 0
Combo4.ListIndex = 0
'設定背景圖型大小及位置
Shape1.Left = 0
Shape1.Width = UserControl.Width
'載入處室資料到下拉是清單副程式
Call B
End Sub
'清單資料載入副程式
Private Sub loadName()
'當選擇為不統計時
If Len(Text1.Text) > 0 And Combo4.Text = "不統計" Then
'建立資料錄物件
Set objRst = New ADODB.Recordset
'開啟資料庫
objRst.Open "select * from [資料表2] " & _
"where [UID] like '" & Text1.Text & "'", _
objCnn, adOpenStatic, adLockPessimistic
'當資料錄有資料時
If objRst.RecordCount > 0 Then
'設定人員姓名
Text4.Text = objRst("UNAME")
'當人員代碼及姓名存在時
If Len(Text1.Text) > 0 And Len(Text4.Text) > 0 Then
'呼叫載入加班資料副程式
Call A
End If
'反之
Else
'清除文字框
Text4.Text = ""
'清除清單項目
ListView1.ListItems.Clear
End If
'關閉資料錄
objRst.Close
'當選擇處室統計時
ElseIf Len(Text1.Text) <= 0 And Len(Text4.Text) <= 0 And Combo4.Text <> "不統計" Then
'呼叫載入加班資料副程式
Call A
End If
End Sub
'載入加班資料副程式
Private Sub A()
'宣告ADO資料庫連結物件
Dim objCnn_A As ADODB.Connection
'宣告ADO資料錄物件
Dim objRst_A As ADODB.Recordset
'宣告清單項目物件
Dim objItem As ListItem
'宣告計數小時變數
Dim lng_TotalHour As Long
'宣告計數分鐘變數
Dim lng_TotalMinute As Long
'建立ADO資料庫連結物件
Set objCnn_A = New ADODB.Connection
'建立ADO資料錄物件
Set objRst_A = New ADODB.Recordset
'開啟資料庫
objCnn_A.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & App.Path & "\db1.mdb;" & _
"Persist Security Info=False"
'當選擇為不統計時
If Len(Text1.Text) > 0 And Len(Text4.Text) > 0 And Combo4.Text = "不統計" Then
'開啟資料錄
objRst_A.Open "select * from [資料表1] where " & _
"[單據年] like '" & Trim(Year(DTPicker1.Value) - 1911 & "") & "' And " & _
"[編號] like '" & Trim(Text1.Text & "") & "' And " & _
"[姓名] like '" & Trim(Text4.Text & "") & "' And " & _
"Len([稽核者]) > 0 ", _
objCnn_A, adOpenStatic, adLockPessimistic
'當選擇處室時
ElseIf Len(Text1.Text) <= 0 And Len(Text4.Text) <= 0 And Combo4.Text <> "不統計" Then
'開啟資料錄
objRst_A.Open "select * from [資料表1] where " & _
"[單據年] like '" & Trim(Year(DTPicker1.Value) - 1911 & "") & "' And " & _
"[處室] like '" & Trim(Combo4.Text & "") & "' And " & _
"Len([稽核者]) > 0 ", _
objCnn_A, adOpenStatic, adLockPessimistic
End If
'清除清單項目
ListView1.ListItems.Clear
'巡覽所有資料錄
Do Until objRst_A.EOF
'當資料錄的日期條件符合範圍時
If CDate(objRst_A("加班開始日期")) > DTPicker1.Value - 1 And _
CDate(objRst_A("加班開始日期")) < DTPicker2.Value + 1 Then
'增加清單項目，加班單代碼
Set objItem = ListView1.ListItems.Add(, , Trim(objRst_A("AID") & ""))
'假若選擇為不統計
If Len(Text1.Text) > 0 And Len(Text4.Text) > 0 And Combo4.Text = "不統計" Then
'設定加班事由
objItem.SubItems(1) = Trim(objRst_A("加班事由") & "")
'假若選擇處室
ElseIf Len(Text1.Text) <= 0 And Len(Text4.Text) <= 0 And Combo4.Text <> "不統計" Then
'設定加班人員姓名及加班事由
objItem.SubItems(1) = Trim(objRst_A("姓名") & "") & " " & Trim(objRst_A("加班事由") & "")
End If
'設定加班資料到清單項目中
objItem.SubItems(2) = Trim(objRst_A("加班開始日期") & "") & " " & Trim(objRst_A("加班開始時間") & "") & " ~ " & _
Trim(objRst_A("加班結束日期") & "") & " " & Trim(objRst_A("加班結束時間") & "")
objItem.SubItems(3) = Trim(objRst_A("加班共計小時") & "") & "小時" & Trim(objRst_A("加班共計分鐘") & "") & "分鐘"
objItem.SubItems(4) = Trim(objRst_A("加班開始日期") & "")
objItem.SubItems(5) = Trim(objRst_A("加班開始時間") & "")
objItem.SubItems(6) = Trim(objRst_A("加班結束日期") & "")
objItem.SubItems(7) = Trim(objRst_A("加班結束時間") & "")
objItem.SubItems(8) = Trim(objRst_A("加班共計小時") & "")
objItem.SubItems(9) = Trim(objRst_A("加班共計分鐘") & "")
objItem.SubItems(10) = Trim(objRst_A("每小時金額") & "")
objItem.SubItems(11) = Trim(objRst_A("稽核者") & "")
objItem.SubItems(12) = Trim(objRst_A("稽核日期") & "")
'設定顏色
objItem.ListSubItems(2).ForeColor = vbBlack
'累計加班時數
lng_TotalHour = lng_TotalHour + Val(Trim(objRst_A("加班共計小時") & ""))
'累計加班分鐘
lng_TotalMinute = lng_TotalMinute + Val(Trim(objRst_A("加班共計分鐘") & ""))
End If
'將資料錄移動到下一筆
objRst_A.MoveNext
Loop
'關閉資料錄
objRst_A.Close
'關閉資料庫
objCnn_A.Close
'釋放記憶體空間
Set objRst_A = Nothing
Set objCnn_A = Nothing
'宣告計數變數
Dim lngI As Long
'巡覽所有清單資料
For lngI = 1 To ListView1.ListItems.Count
'當發現有被稽核的資料項目
If Len(ListView1.ListItems(lngI).SubItems(11)) > 0 Then
'設定顏色
ListView1.ListItems(lngI).ForeColor = vbBlue
ListView1.ListItems(lngI).ListSubItems(1).ForeColor = vbBlue
ListView1.ListItems(lngI).ListSubItems(2).ForeColor = vbBlue
ListView1.ListItems(lngI).ListSubItems(3).ForeColor = vbBlue
ListView1.ListItems(lngI).ListSubItems(4).ForeColor = vbBlue
ListView1.ListItems(lngI).ListSubItems(5).ForeColor = vbBlue
ListView1.ListItems(lngI).ListSubItems(6).ForeColor = vbBlue
ListView1.ListItems(lngI).ListSubItems(7).ForeColor = vbBlue
ListView1.ListItems(lngI).ListSubItems(8).ForeColor = vbBlue
ListView1.ListItems(lngI).ListSubItems(9).ForeColor = vbBlue
ListView1.ListItems(lngI).ListSubItems(10).ForeColor = vbBlue
ListView1.ListItems(lngI).ListSubItems(11).ForeColor = vbBlue
ListView1.ListItems(lngI).ListSubItems(12).ForeColor = vbBlue
End If
Next lngI
End Sub
'載入處室資料到下拉是清單副程式
Private Sub B()
'建立資料錄物件
Set objRst = New ADODB.Recordset
'開啟資料錄
objRst.Open "select DISTINCT [UGROUP] from [資料表2] ", _
objCnn, adOpenStatic, adLockPessimistic
'宣告索引變數
Dim int_Index As Integer
'設定索引初始值
int_Index = 1
'清除處室下拉式選單項目
Combo4.Clear
'增加處室下拉式選單項目
Combo4.AddItem "不統計", 0
Combo4.ListIndex = 0
'巡覽所有資料錄
Do Until objRst.EOF = True
'當發現有處室名稱時
If Len(Trim(objRst("UGROUP") & "")) > 0 Then
'新增處室名稱至下拉式選單中
Combo4.AddItem Trim(objRst("UGROUP") & ""), int_Index
'索引值累加
int_Index = int_Index + 1
End If
'資料錄往下移動一筆
objRst.MoveNext
Loop
'關閉資料錄
objRst.Close
End Sub
'加班時間統計表自訂使用者控制項大小調整事件副程式
Private Sub UserControl_Resize()
'設定背景圖型大小及位置
Shape1.Left = 0
Shape1.Width = UserControl.Width
End Sub
'加班時間統計表自訂使用者控制項結束事件副程式
Private Sub UserControl_Terminate()
'關閉資料庫
objCnn.Close
'釋放記憶體空間
Set objCnn = Nothing
End Sub
2.6.5 職員管理之控制項設計¶
Step 1：這是職員管理的控制項。請參考如圖2-5的版面配置。
圖 2‑5 職員管理之介面配置
Step 2：請加以下程式碼加入使用者自訂控制項中。
'設定所有變數必須宣告才能使用
Option Explicit
'宣告ADO資料庫連結物件
Dim objCnn As ADODB.Connection
'宣告ADO資料錄物件
Dim objRst As ADODB.Recordset
'宣告清單項目物件
Dim objItem As ListItem
'職員管理自訂控制項初始化事件副程式
Private Sub UserControl_Initialize()
'建立ADO資料庫連結物件
Set objCnn = New ADODB.Connection
'開啟資料庫
objCnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & App.Path & "\db1.mdb;" & _
"Persist Security Info=False"
'建立ADO資料錄物件
Set objRst = New ADODB.Recordset
'設定背景圖型大小及位置
Shape1.Left = 0
Shape1.Width = UserControl.Width
'設定清單排序功能
ListView1.Sorted = True
ListView1.SortKey = 1
'呼叫載入職員資料副程式
Call A
End Sub
'單筆新增按鈕點選事件副程式
Private Sub Command1_Click()
'宣告要使用的變數
Dim strRecord_A, strRecord_B, strRecord_C As String
'當沒有輸入編號
If Len(Text1.Text) <= 0 Then
'顯示訊息
labMessage.ForeColor = vbRed
labMessage.Caption = "訊息：尚未輸入編號。"
'跳離副程式
Exit Sub
End If
'當沒有輸入姓名
If Len(Text2.Text) <= 0 Then
'顯示訊息
labMessage.ForeColor = vbRed
labMessage.Caption = "訊息：尚未輸入姓名。"
'跳離副程式
Exit Sub
End If
'當沒有輸入處室名稱
If Len(Text3.Text) <= 0 Then
'顯示訊息
labMessage.ForeColor = vbRed
labMessage.Caption = "訊息：尚未輸入處室。"
'跳離副程式
Exit Sub
End If
'取得相關資料
strRecord_A = Trim(Text1.Text & "")
strRecord_B = Trim(Text2.Text & "")
strRecord_C = Trim(Text3.Text & "")
'宣告ADO資料庫連結物件
Dim objCnn_ADD As ADODB.Connection
'宣告ADO資料錄物件
Dim objRst_Add As ADODB.Recordset
'宣告字串變數
Dim strSQL As String
'建立ADO資料庫連結物件
Set objCnn_ADD = New ADODB.Connection
'建立ADO資料錄物件
Set objRst_Add = New ADODB.Recordset
'設定資料庫連結命令文字
strSQL = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & App.Path & "\db1.mdb" & ";" & _
"Mode=Read|Write|Share Deny None;" & _
"Persist Security Info=False;"
'開啟資料庫
objCnn_ADD.Open strSQL
'設定資料錄已使用者代碼來搜尋
strSQL = "Select * From [資料表2] Where [UID] Like '" & Trim(Text1.Text & "") & "'"
'開啟資料錄
objRst_Add.Open strSQL, objCnn_ADD, adOpenStatic, adLockPessimistic
'當沒有找到資料
If objRst_Add.RecordCount <= 0 Then
'則準備新增
objRst_Add.AddNew
'設定代碼
objRst_Add("UID") = Trim(Text1.Text & "")
'設定人員姓名
objRst_Add("UNAME") = Trim(Text2.Text & "")
'設定處室名稱
objRst_Add("UGROUP") = Trim(Text3.Text & "")
'當選擇稽核權時
If Check1.Value = 1 Then
'紀錄稽核資料
objRst_Add("UCHECK") = "Yes"
Else
'清除稽核資料
objRst_Add("UCHECK") = ""
End If
'資料更新
objRst_Add.Update
'當發現有資料時
ElseIf objRst_Add.RecordCount > 0 Then
'顯示訊息
labMessage.ForeColor = vbRed
labMessage.Caption = "訊息：編號重複，無法加入。"
End If
'關閉資料錄
objRst_Add.Close
'關閉資料庫
objCnn_ADD.Close
'釋放記憶體空間
Set objRst_Add = Nothing
Set objCnn_ADD = Nothing
'呼叫載入職員資料副程式
Call A(Trim(Text1.Text & ""))
End Sub
'批次刪除按鈕點選事件副程式
Private Sub Command2_Click()
'宣告計數變數
Dim intI As Integer
'宣告代碼字串變數
Dim str_DeleteID As String
'初始化代碼字串
str_DeleteID = ""
'巡覽所有清單資料項目
For intI = 1 To ListView1.ListItems.Count
'當發現有被勾選時
If ListView1.ListItems(intI).Checked = True Then
'紀錄代碼到字串中
str_DeleteID = str_DeleteID & ListView1.ListItems(intI).Text & ","
End If
Next intI
'當沒有勾選代碼
If Len(str_DeleteID) <= 0 Then
'顯示提示訊息
labMessage.ForeColor = vbRed
labMessage.Caption = "訊息：請勾選要刪除的人員。"
'跳離副程式
Exit Sub
End If
'詢問是否要刪除資料
If MsgBox("請問是否確定要刪除呢？", vbYesNo, "訊問") = vbNo Then
Exit Sub
End If
'宣告ADO資料連結物件
Dim objCnn_Del As ADODB.Connection
'建立ADO資料連結物件
Set objCnn_Del = New ADODB.Connection
'開啟資料庫
objCnn_Del.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & App.Path & "\db1.mdb;" & _
"Persist Security Info=False"
'執行刪除命令
objCnn_Del.Execute "Delete From [資料表2] " & _
"Where [AID] In (" & Left(str_DeleteID, Len(str_DeleteID) - 1) & ")"
'關閉資料庫
objCnn_Del.Close
'釋放記憶體空間
Set objCnn_Del = Nothing
'呼叫載入職員資料副程式
Call A
End Sub
'批次修改按鈕被點選事件副程式
Private Sub Command3_Click()
'宣告計數變數
Dim intI As Integer
'宣告代碼字串變數
Dim str_AID As String
'宣告ADO資料庫連結物件
Dim objCnn_ADD As ADODB.Connection
'清空代碼字串
str_AID = ""
'巡覽清單中所有項目
For intI = 1 To ListView1.ListItems.Count
'當有資料項目被勾選
If ListView1.ListItems(intI).Checked = True Then
'字串累計代碼
str_AID = str_AID & ListView1.ListItems(intI).Text & ","
End If
Next intI
'當沒有勾選代碼
If Len(str_AID) <= 0 Then
'宣告字串變數
Dim str_Check As String
'當備核取時
If Check1.Value = 1 Then
'設定核取旗標
str_Check = "Yes"
'反之
ElseIf Check1.Value = 0 Then
'清除核取旗標
str_Check = ""
End If
'建立ADO資料庫連結物件
Set objCnn_ADD = New ADODB.Connection
'開啟資料庫
objCnn_ADD.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & App.Path & "\db1.mdb;" & _
"Persist Security Info=False"
'執行資料庫更新
objCnn_ADD.Execute "Update [資料表2] " & _
"Set [UNAME] = '" & Trim(Text2.Text & "") & "' , " & _
"[UGROUP] = '" & Trim(Text3.Text & "") & "', " & _
"[UCHECK] = '" & Trim(str_Check & "") & "' " & _
"Where [AID] Like '" & Trim(ListView1.SelectedItem.Text & "") & "'"
'關閉資料庫
objCnn_ADD.Close
'釋放記憶體空間
Set objCnn_ADD = Nothing
'呼叫載入職員資料副程式
Call A(Trim(ListView1.SelectedItem.Text & ""))
'反之
Else
'詢問是否要整批修改處室名稱
If MsgBox("請問您要整批修改處室名稱嗎？", vbYesNo, "訊問") = vbYes Then
'禁能文字框
Text1.Enabled = False
Text2.Enabled = False
'建立ADO資料庫連結物件
Set objCnn_ADD = New ADODB.Connection
'開啟資料庫
objCnn_ADD.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & App.Path & "\db1.mdb;" & _
"Persist Security Info=False"
'執行資料庫更新
objCnn_ADD.Execute "Update [資料表2] " & _
"Set [UGROUP] = '" & Trim(Text3.Text & "") & "' " & _
"Where [AID] In (" & Left(str_AID, Len(str_AID) - 1) & ")"
'關閉資料庫
objCnn_ADD.Close
'釋放記憶體空間
Set objCnn_ADD = Nothing
'呼叫載入職員資料副程式
Call A
'設定文字框
Text1.BackColor = &HFFFFFF
Text2.BackColor = &HFFFFFF
'設定控制項啟用
Text1.Enabled = True
Text2.Enabled = True
Check1.Enabled = True
End If
End If
End Sub
'清單欄位點選事件副程式
Private Sub ListView1_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)
'設定允許排序
ListView1.Sorted = True
'設定排序的鍵值
ListView1.SortKey = ColumnHeader.Index - 1
End Sub
'清單項目被勾選事件副程式
Private Sub ListView1_ItemCheck(ByVal Item As MSComctlLib.ListItem)
'宣告計數變數
Dim intI As Integer
'宣告代碼字串變數
Dim str_AID As String
'初始化變數
str_AID = ""
'巡覽所有清單項目
For intI = 1 To ListView1.ListItems.Count
'當有資料備核取時
If ListView1.ListItems(intI).Checked = True Then
'累計代碼到字串中
str_AID = str_AID & ListView1.ListItems(intI).Text & ","
End If
Next intI
'設定文字框及啟用控制項
Text1.BackColor = &HFFFFFF
Text2.BackColor = &HFFFFFF
Text1.Enabled = True
Text2.Enabled = True
Check1.Enabled = True
'當代碼存在時
If Len(str_AID) > 0 Then
'設定清除文字框及禁用控制項
Text1.BackColor = &HFFC0FF
Text2.BackColor = &HFFC0FF
Text1.Text = ""
Text2.Text = ""
Text1.Enabled = False
Text2.Enabled = False
Check1.Enabled = False
'反之
Else
'當清單中有資料時
If ListView1.ListItems.Count > 0 Then
'設定清單項目資料到文字框中
Text1.Text = ListView1.SelectedItem.SubItems(1)
Text2.Text = ListView1.SelectedItem.SubItems(2)
Text3.Text = ListView1.SelectedItem.SubItems(3)
'設定核取框動作，依據清單中的資料
If Trim(ListView1.SelectedItem.SubItems(4) & "") = "Ｏ" Then
Check1.Value = 1
Else
Check1.Value = 0
End If
End If
End If
End Sub
'清單項目被點選事件副程式
Private Sub ListView1_ItemClick(ByVal Item As MSComctlLib.ListItem)
'設定文字框內容，依據清單項目資料
Text1.Text = ListView1.SelectedItem.SubItems(1)
Text2.Text = ListView1.SelectedItem.SubItems(2)
Text3.Text = ListView1.SelectedItem.SubItems(3)
'設定核取框動作，依據清單中的資料
If Trim(ListView1.SelectedItem.SubItems(4) & "") = "Ｏ" Then
Check1.Value = 1
Else
Check1.Value = 0
End If
End Sub
'人員管理自訂控制項調整大小位置事件副程式
Private Sub UserControl_Resize()
'調整背景圖型大小及位置
Shape1.Left = 0
Shape1.Width = UserControl.Width
End Sub
'載入職員資料副程式
Private Sub A(Optional strListPoint As String)
'宣告ADO資料庫連結物件
Dim objCnn_A As ADODB.Connection
'宣告ADO資料錄物件
Dim objRst_A As ADODB.Recordset
'宣告清單項目物件
Dim objItem As ListItem
'建立ADO資料庫連結物件
Set objCnn_A = New ADODB.Connection
'建立ADO資料錄物件
Set objRst_A = New ADODB.Recordset
'開啟資料庫
objCnn_A.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & App.Path & "\db1.mdb;" & _
"Persist Security Info=False"
'開啟資料錄
objRst_A.Open "select * from [資料表2] Order By [UID] DESC", _
objCnn_A, adOpenStatic, adLockPessimistic
'清除清單項目
ListView1.ListItems.Clear
'巡覽所有資料錄
Do Until objRst_A.EOF
'設定新增加班項目代碼
Set objItem = ListView1.ListItems.Add(, , Trim(objRst_A("AID") & ""))
'設定人員編號
objItem.SubItems(1) = Trim(objRst_A("UID") & "")
'設定人員姓名
objItem.SubItems(2) = Trim(objRst_A("UNAME") & "")
'設定處室姓名
objItem.SubItems(3) = Trim(objRst_A("UGROUP") & "")
'設定稽核情形
If Trim(objRst_A("UCHECK") & "") = "Yes" Then
objItem.SubItems(4) = "Ｏ"
End If
'設定顏色
objItem.ListSubItems(2).ForeColor = vbBlack
'將資料錄移動到下一筆
objRst_A.MoveNext
Loop
'關閉資料錄
objRst_A.Close
'關閉資料庫
objCnn_A.Close
'設定記憶體空間釋放
Set objRst_A = Nothing
Set objCnn_A = Nothing
'當清單有資料時
If ListView1.ListItems.Count > 0 Then
'設定第一筆資料被選擇
ListView1.ListItems(1).Selected = True
'展開資料
ListView1.ListItems(1).EnsureVisible
'尋找資料
Set objItem = ListView1.FindItem(strListPoint, 0, , lvwPartial)
'當發現有資料時
If Not (objItem Is Nothing) = True Then
'選擇資料
objItem.Selected = True
'展開資料
objItem.EnsureVisible
End If
End If
End Sub
'人員管理自訂控制項結束事件副程式
Private Sub UserControl_Terminate()
'關閉資料庫
objCnn.Close
'釋放記憶體空間
Set objCnn = Nothing
End Sub
2.6.7 加班薪資統計系統展示¶
我們預設管理者帳號：管理者、密碼：ADMIN；稽核者帳號：稽核者、密碼：CHECK；輸入者帳號：輸入者、密碼：ACC。接下來我們將以管理者的權限為各位介紹全部的功能。請參考圖2-6～2-10。
圖 2‑6 管理者登入畫面
圖 2‑7 加班單登錄畫面
圖 2‑8 加班稽核單畫面
圖 2‑9 加班統計單畫面
圖 2‑10 職員管理畫面
2.7 修改重點¶
修改本程式基本上是修改使用者自訂控制項，只要資料庫結構不變，相同的資料庫就可配合各種使用者自訂控制項，製作出不同的程式系統。因此要修改本程式的時候，應該要將焦點放在使用者自訂控制項，而設計的時候千萬不要讓各控制項產生關聯，因為有了關聯之後，你就無法自由的移植控制項，程式會被綁死。
2.8 結論¶
透過顯示與隱藏工具按鈕就可以達到權限功能控制的目的，這是很簡單的寫法。而本程式將介面與控制項分開設計，將有助於未來擴充能力，因為控制項可以隨時移值，並且控制項之間並無關連，所以可以達到單獨移植的能力，而不需修改任何程式碼，這種設計方式就可達到程式碼重複使用的目的。您若覺得本程式的介面不符合您的使用，您大可移除掉介面，重新設計，然後透過移植控制項的方式，就可以完成您的程式了。
有時候透過數學的計算，您可以省去許多邏輯的判斷，就以本程式來說透過簡單的加減法，就可以知道時間日期是否有重疊，倘若您用邏輯判斷的寫法，包準您會寫出長篇大論出來，而功能卻是一樣的，因為筆者已經嘗試過用邏輯的寫法，您大可放心。
2.9 備註¶
本程式有引用Spencer Yang所設計的函數，請讀者參考，該函數可以格式化並計算兩個日期的時間差，相當好用，故在此推薦使用。也感謝Spencer Yang無私的貢獻。
版權聲明¶
Lai Tai-Yu (賴岱佑)
