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 (賴岱佑)

回到教材說明