Excel VBA: 考勤管理，精細時間打卡，遲到加班分秒不差

No.1

以前做過考勤管理，以天為單位進行設定，根據不同的企業公司上班需求，嚴格來說，必須精細到分鐘，這樣就給我們提出了新的任務。

本節介紹一個簡單的考勤應用模式，實現時間打卡，精確到分鐘。

上圖為示例圖片，也是主操作頁和考勤管理主頁。

可以很清楚地看到員工資訊一考勤記錄，其實現起來很簡單，直接在考勤日期單元格單擊滑鼠會自動彈出考勤設定頁。

下圖為本表後半部分內容，主要是考勤總結計算。

單擊考勤表某個人的某一天單元格自動彈出下面對話方塊，進行考勤打卡。

員工資訊會自動顯示出來，如果不正確就不用打卡。

下面是打卡日期，出勤類型，這裡多了兩個類型，加班和遲到。此兩項和下面的上班時間和下班時間有一定的資料計算。

可以設定上班時間，和下班時間，如果超出相應的工作時間就會提示選擇。

而且分別進行了一些時間計算，相對比較複雜一點。

而且，此示例還增加了考勤匯出功能，可以實現儲存到一個新表當中備份。

所以還是有一定的使用功能。

No.2

下面看一下實現程式碼

Private Sub CommandButton1_Click()Dim xObj As ObjectFor Each xObj In Me.ControlsIf TypeName(xObj) = "OptionButton" ThenIf xObj.Value ThenIf VBA.Len(getCstr(xObj)) = 0 Then MsgBox "打卡失敗: " & xObj.Caption, vbInformation, "提示": Exit SubIf checkOut(getTimeHours) Then '檢測如果遲到If xObj.Caption <> strK(6) Then MsgBox "沒有選擇正確！" & strK(6): Exit SubActiveSheet.Cells(ir, ic).Value = VBA.Right(strK(6), 1)MsgBox "打卡成功: " & VBA.vbCrLf & strK(6), vbInformation, "提示"Else '沒有遲到If checkOn(getTimeHours) Then '檢測如果加班If xObj.Caption <> strK(5) Then MsgBox "沒有選擇正確！" & strK(5): Exit SubActiveSheet.Cells(ir, ic).Value = VBA.Right(strK(5), 1)MsgBox "打卡成功: " & VBA.vbCrLf & strK(5), vbInformation, "提示"Else '不加班ActiveSheet.Cells(ir, ic).Value = getCstr(xObj)MsgBox "打卡成功: " & VBA.vbCrLf & xObj.Caption, vbInformation, "提示"End IfEnd IfThisWorkbook.SaveUnload MeEnd IfEnd IfNext xObjEnd Sub

資訊初始化

Private Sub CommandButton1_Click()Application.ScreenUpdating = FalseDim R As Range, cell As RangeSet R = ActiveSheet.Range("B2")ClearCen R '清除資料Dim yArr, Ci As Long, Ri As LongyArr = ThisWorkbook.Worksheets("資訊").UsedRangeCi = UBound(yArr, 2)Ri = UBound(yArr, 1)Set cell = R.Resize(Ri, Ci)With cell.Value = yArr.HorizontalAlignment = xlCenter.VerticalAlignment = xlCenter.Borders.LineStyle = 2.Borders.Color = RGB(189, 189, 235)End WithApplication.ScreenUpdating = TrueEnd Sub

考勤管理一般有專業的打卡機進行處理，可以匯出xls檔案，不過某些公司內部還是需要自己進行建表計算，所以這方面的應用也是十分廣泛。

歡迎關注、收藏

---END---