结果如下图:点“确定”按钮,将打钩的日期添加到工作表:
步骤:
1.插入用户窗体,在窗体上添加多页,在第2个页面“Page2”上添加“确定”按钮,再添加两个标签,其它控件及显示内容都是自动生成。
2.在通用“声明”中添加:
Option Explicit
Public WithEvents ComboBoxYear As MSForms.ComboBox
Public WithEvents ComboBoxMonth As MSForms.ComboBox
3.UserForm的初始设置:
Private Sub UserForm_Initialize()
' Const LabelWidth As Integer = 20
' Const LabelHeight As Integer = 40
' Const CheckBoxWidth As Integer = 45
' Const SpaceBetween As Integer = 0
' Dim arr1(7, 7), arr2(7, 7)
' Dim i, j, k As Integer
' Dim weekDays, currentDate As Date
' Dim firstDayOfMonth As Date
' Dim dayOfWeek As Integer
Dim year1 As Integer
Dim Month1 As Date
Set ComboBoxYear = Me.MultiPage1.Pages("Page2").Controls.Add("Forms.ComboBox.1", "ComboBoxYear")
With ComboBoxYear
.Left = 100
.Top = 10
.Width = 120
' .Value = year(Date)
End With
' 填充ComboBoxYear为当前年前后6年的年份列表
For year1 = year(Date) - 3 To year(Date) + 3
ComboBoxYear.AddItem year1
Next year1
' 创建ComboBoxMonth控件
Set ComboBoxMonth = Me.MultiPage1.Pages("Page2").Controls.Add("Forms.ComboBox.1", "ComboBoxMonth")
With ComboBoxMonth
.Left = 300
.Top = 10
.Width = 120
' .Value = Format(month(Date), "00")
End With
' 填充ComboBoxMonth为1到12月的月份列表
For Month1 = 1 To 12
ComboBoxMonth.AddItem Format(Month1, "00")
Next Month1
' 设置当前年份为ComboBoxYear的默认选项
ComboBoxYear.value = year(Date)
' 设置当前月份为ComboBoxMonth的默认选项
ComboBoxMonth.value = Format(Month(Date) - 1, "00") ‘如果取当月,减1取消
End Sub
4.ComboBoxMonth的值改变时的事件处理程序
Private Sub ComboBoxMonth_Change()
Const LabelWidth As Integer = 20
Const LabelHeight As Integer = 40
Const CheckBoxWidth As Integer = 45
Const SpaceBetween As Integer = 0
Dim arr1(7, 7), arr2(7, 7)
Dim i, j, k As Integer
Dim weekDays, currentDate As Date
Dim firstDayOfMonth As Date
Dim dayOfWeek As Integer
Dim ctrl As Control
Dim controlsToDelete As Collection
' 初始化要删除的控件集合
Set controlsToDelete = New Collection
' 循环遍历Page2中的所有控件
For i = Me.MultiPage1.Pages("Page2").Controls.Count - 1 To 0 Step -1
Set ctrl = Me.MultiPage1.Pages("Page2").Controls(i)
' 检查控件类型是否不是ComboBox和Label,如果不是,则将其加入要删除的集合
If TypeName(ctrl) <> "ComboBox" And (ctrl.Name <> "Label1" And ctrl.Name <> "Label2") And TypeName(ctrl) <> "CommandButton" Then
controlsToDelete.Add ctrl
End If
Next i
' 删除要删除的控件
For Each ctrl In controlsToDelete
Me.MultiPage1.Pages("Page2").Controls.Remove ctrl.Name
Next ctrl
If ComboBoxYear.value = "" Then
ComboBoxYear.value = year(Date)
End If
' 设置当前月份的第一天
firstDayOfMonth = ComboBoxYear.value & "年" & ComboBoxMonth.value & "月"
' 计算第一天是星期几(1 = 星期日,2 = 星期一,等等)
dayOfWeek = Weekday(firstDayOfMonth)
Me.Label1.Caption = "统计年月:" + Format(firstDayOfMonth, "YYYY年MM月")
Me.Label2.Caption = "日期打√表示休息"
' 第一行标签为星期名称
' Dim weekDays As Variant
weekDays = Array("星期日", "星期一", "星期二", "星期三", "星期四", "星期五", "星期六")
' 创建日期标签和复选框
For i = 1 To 7 ' 七行
If i = 1 Then
For k = 0 To 6
With Me.MultiPage1.Pages("Page2").Controls.Add("Forms.Label.1", "WeekDayLabel" & k, True)
.Caption = weekDays(k)
.Left = k * (LabelWidth + CheckBoxWidth + SpaceBetween) + 50
.Top = 50
.Width = LabelWidth + 40
.Height = LabelHeight
.BorderColor = &H80000002
' .TextAlign = 2
.Font.Size = 12
End With
Next k
End If
For j = 0 To 6 ' 每行七个(星期一至星期日)
' 计算当前日期
currentDate = DateAdd("d", (i - 2) * 7 + j - dayOfWeek + 1, firstDayOfMonth)
' 仅在当前月份创建日期标签
If Month(currentDate) = Month(firstDayOfMonth) Then
' 创建日期标签
With Me.MultiPage1.Pages("Page2").Controls.Add("Forms.Label.1", "DateLabel" & i & j, True)
.Caption = day(currentDate)
.Left = j * (LabelWidth + CheckBoxWidth + SpaceBetween) + 50
.Top = i * (LabelHeight + SpaceBetween)
.Width = LabelWidth
.Height = LabelHeight
.Font.Size = 16
End With
' 创建复选框,除第一行外
If i > 1 Then
With Me.MultiPage1.Pages("Page2").Controls.Add("Forms.CheckBox.1", "CheckBox" & i & j, True)
.Left = j * (LabelWidth + CheckBoxWidth + SpaceBetween) + LabelWidth + 50
.Top = i * (LabelHeight + SpaceBetween)
.Width = CheckBoxWidth
.Height = LabelHeight - 20
' 如果是星期日,则打钩
If j = 0 Then .value = True
End With
End If
End If
Next j
Next i
End Sub
5.ComboBoxYear的值改变时的事件处理程序
Private Sub ComboBoxYear_Change()
Const LabelWidth As Integer = 20
Const LabelHeight As Integer = 40
Const CheckBoxWidth As Integer = 45
Const SpaceBetween As Integer = 0
Dim arr1(7, 7), arr2(7, 7)
Dim i, j, k As Integer
Dim weekDays, currentDate As Date
Dim firstDayOfMonth As Date
Dim dayOfWeek As Integer
Dim ctrl As Control
Dim controlsToDelete As Collection
' 初始化要删除的控件集合
Set controlsToDelete = New Collection
' 循环遍历Page2中的所有控件
For i = Me.MultiPage1.Pages("Page2").Controls.Count - 1 To 0 Step -1
Set ctrl = Me.MultiPage1.Pages("Page2").Controls(i)
' 检查控件类型是否不是ComboBox和Label,如果不是,则将其加入要删除的集合
If TypeName(ctrl) <> "ComboBox" And (ctrl.Name <> "Label1" And ctrl.Name <> "Label2") And TypeName(ctrl) <> "CommandButton" Then
controlsToDelete.Add ctrl
End If
Next i
' 删除要删除的控件
For Each ctrl In controlsToDelete
Me.MultiPage1.Pages("Page2").Controls.Remove ctrl.Name
Next ctrl
If Trim(ComboBoxMonth.value) = "" Then
ComboBoxMonth.value = Month(Date) - 1 ‘如果取当月,减1取消
End If
' 设置当前月份的第一天
firstDayOfMonth = ComboBoxYear.value & "年" & ComboBoxMonth.value & "月"
' 计算第一天是星期几(1 = 星期日,2 = 星期一,等等)
dayOfWeek = Weekday(firstDayOfMonth)
Me.Label1.Caption = "统计年月:" + Format(firstDayOfMonth, "YYYY年MM月")
Me.Label2.Caption = "日期打√表示休息"
' 第一行标签为星期名称
weekDays = Array("星期日", "星期一", "星期二", "星期三", "星期四", "星期五", "星期六")
' 创建日期标签和复选框
For i = 1 To 7 ' 七行
If i = 1 Then
For k = 0 To 6
With Me.MultiPage1.Pages("Page2").Controls.Add("Forms.Label.1", "WeekDayLabel" & k, True)
.Caption = weekDays(k)
.Left = k * (LabelWidth + CheckBoxWidth + SpaceBetween) + 50
.Top = 50
.Width = LabelWidth + 40
.Height = LabelHeight
.BorderColor = &H80000002
' .TextAlign = 2
.Font.Size = 12
End With
Next k
End If
For j = 0 To 6 ' 每行七个(星期一至星期日)
' 计算当前日期
currentDate = DateAdd("d", (i - 2) * 7 + j - dayOfWeek + 1, firstDayOfMonth)
' 仅在当前月份创建日期标签
If Month(currentDate) = Month(firstDayOfMonth) Then
' 创建日期标签
With Me.MultiPage1.Pages("Page2").Controls.Add("Forms.Label.1", "DateLabel" & i & j, True)
.Caption = day(currentDate)
.Left = j * (LabelWidth + CheckBoxWidth + SpaceBetween) + 50
.Top = i * (LabelHeight + SpaceBetween)
.Width = LabelWidth
.Height = LabelHeight
.Font.Size = 16
End With
' 创建复选框,除第一行外
If i > 1 Then
With Me.MultiPage1.Pages("Page2").Controls.Add("Forms.CheckBox.1", "CheckBox" & i & j, True)
.Left = j * (LabelWidth + CheckBoxWidth + SpaceBetween) + LabelWidth + 50
.Top = i * (LabelHeight + SpaceBetween)
.Width = CheckBoxWidth
.Height = LabelHeight - 20
' 如果是星期日,则打钩
If j = 0 Then .value = True
End With
End If
End If
Next j
Next i
End Sub
6.点“确定”代码,将勾选的日期添加到工作表"工厂日历休假"中
Private Sub CommandButton1_Click()
Dim arr1(7, 7), arr2(7, 7)
Dim i, j, k As Integer
Dim weekDays, currentDate As Date
Dim firstDayOfMonth As Date
Dim lastRow As Long
Dim dayOfWeek As Integer
' 设置当前月份的第一天
firstDayOfMonth = DateSerial(UserForm1.ComboBoxYear.value, CInt(UserForm1.ComboBoxMonth.value), 1)
' 计算第一天是星期几(1 = 星期日,2 = 星期一,等等)
dayOfWeek = Weekday(firstDayOfMonth)
Sheets("工厂日历休假").Activate
lastRow = Sheets("工厂日历休假").Cells(Rows.Count, "A").End(xlUp).Row
If lastRow > 1 Then
Sheets("工厂日历休假").Range("A2:A" & lastRow).ClearContents
End If
k = 1
For i = 2 To 7
For j = 0 To 6
currentDate = DateAdd("d", (i - 2) * 7 + j - dayOfWeek + 1, firstDayOfMonth)
If Month(currentDate) = Month(firstDayOfMonth) Then
If Me.Controls("CheckBox" & i & j).value = True Then
arr1(i, j) = currentDate
arr2(i, j) = Me.Controls("CheckBox" & i & j).value
Sheets("工厂日历休假").Cells(k + 1, 1) = arr1(i, j)
k = k + 1
' Debug.Print i, j, arr1(i, j)
End If
End If
Next j
Next i
End Sub