玖叶教程网

前端编程开发入门

VBA:创建工厂日历(用excel vba完成日报)

结果如下图:点“确定”按钮,将打钩的日期添加到工作表:

步骤:

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

发表评论:

控制面板
您好,欢迎到访网站!
  查看权限
网站分类
最新留言