No.1

以前做过考勤管理，以天为单位进行设置，根据不同的企业公司上班需求，严格来说，必须精细到分钟，这样就给我们提出了新的任务。

本节介绍一个简单的考勤应用模式，实现时间打卡，精确到分钟。

excelvba考勤表如何添加周日颜色,excelvba考勤实例

上图为示例图片，也是主操作页和考勤管理主页。

可以很清楚地看到员工信息一考勤记录，其实现起来很简单，直接在考勤日期单元格单击鼠标会自动弹出考勤设置页。

下图为本表后半部分内容，主要是考勤总结计算。

excelvba考勤表如何添加周日颜色,excelvba考勤实例

单击考勤表某个人的某一天单元格自动弹出下面对话框，进行考勤打卡。

员工信息会自动显示出来，如果不正确就不用打卡。

下面是打卡日期，出勤类型，这里多了两个类型，加班和迟到。此两项和下面的上班时间和下班时间有一定的数据计算。

excelvba考勤表如何添加周日颜色,excelvba考勤实例

可以设定上班时间，和下班时间，如果超出相应的工作时间就会提示选择。

而且分别进行了一些时间计算，相对比较复杂一点。

而且，此示例还增加了考勤导出功能，可以实现保存到一个新表当中备份。

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

No.2

下面看一下实现代码

excelvba考勤表如何添加周日颜色,excelvba考勤实例

Private Sub CommandButton1_Click()
Dim xObj As Object
For Each xObj In Me.Controls
    If TypeName(xObj) = "OptionButton" Then
        If xObj.Value Then
            If VBA.Len(getCstr(xObj)) = 0 Then MsgBox "打卡失败: " & xObj.Caption, vbInformation, "提示": Exit Sub
                If checkOut(getTimeHours) Then '检测如果迟到
                        If xObj.Caption <> strK(6) Then MsgBox "没有选择正确！" & strK(6): Exit Sub
                            ActiveSheet.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 Sub
                            ActiveSheet.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 If
                End If
            ThisWorkbook.Save
            Unload Me
        End If
    End If
Next xObj
End Sub

excelvba考勤表如何添加周日颜色,excelvba考勤实例

信息初始化

Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
Dim R As Range, cell As Range
Set R = ActiveSheet.Range("B2")
ClearCen R '清除数据
Dim yArr, Ci As Long, Ri As Long
yArr = ThisWorkbook.Worksheets("信息").UsedRange
Ci = 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 With
Application.ScreenUpdating = True
End Sub

考勤管理一般有专业的打卡机进行处理，可以导出xls文件，不过某些公司内部还是需要自己进行建表计算，所以这方面的应用也是十分广泛。

欢迎关注、收藏

---END---

vba做考勤统计上下班打卡时间 (excel vba自动生成考勤)

No.1

No.2