VBA中使用动态控件数组来模拟微软日历控件

曹先生

在工作中，使用VBA写了个小程序，需要使用日历控件。好像是从2010版开始，VBA就没有日历控件了，网上有些讨论，可以自行添加该控件。可惜，这些方法只适合于32位版的Office，并不适合64位的。所以，为了使用日历控件，工作用的电脑就一直使用旧电脑而没有更新。近来感觉这台电脑工作起来越来越力不从心，而桌面的空间又不允许添加第二台电脑，于是，改用VS重新写了这个小程序。

我毕竟是业余爱好者，使用VS还是有些吃力的。或许有人会问VBA与VS有什么区别？我的感受就是手机相机与单反相机的区别。想像一下，这台单反相机配置了大量的变焦头、定焦头、外接闪光灯、引闪器、线快门及遥控快门等等的配件。在使用过程中，一个不注意，拍出来的照片可能还不如手机拍出来的效果好。

在工作的过程中，除了我还有其他人要使用这个小程序。我说过我是业余爱好者，本职工作是医生。呵呵，想像一下，这个VS的小程序会达到什么样的效果！

经常出错，一旦出错，除了我，没人会处理，而且，在工作的过程中也不允许我一点点地去处理问题，要快速地解决。

没有办法，只好又换回了那台老电脑！

但一直没有死心升级工作电脑。于是，在网上查了下，终于有了结果。

在论坛的这个帖子中(http://club.excelhome.net/thread-1396748-1-1.html)，楼主说在64位版的Office中实现了日历控件。我试了下，并没有成功，感觉帖子中提及的那个日历控件是第三方的商业控件。

另外，还有几个帖子讨论使用自己用简单的控件实现日历的功能。（http://club.excelhome.net/thread-1431756-2-1.html，http://club.excelhome.net/thread-1443945-1-1.html 。 还有其它的，例举的不全）。

下载了两个，真是佩服作者的思路！尤其是有一个还能显示农历。

这些文件都是在窗体上直接添加了按钮控件，日期的相关控件是42个，代码更是密密麻麻的一大堆。我的水平有限，读这些代码感觉头痛。在使用过程，还要重新调整控件的大小和位置等等，感觉好累。

这些作者给我提供了一个极好的思路，即使用微软最基本的控件去模拟日历控件。

为了避免大量的代码，决定使用动态控件数组。自己以前从来没有做过这样的事情，于是在网上查了一下，这个文章给了我极大的帮助：http://www.360doc.com/content/10/0112/14/406571_13343606.shtml

曹先生

这是下载的一个非常好的VBA程序，只是代码太多了，密密麻麻的，看着头大！

曹先生

使用动态控件数组，则极大地简化了代码，而且，窗体看起来也简捷些。


窗体上仅添加一个框架控件(Frame），并在其中添加与年、月、日有关的标签、复合框和文本框控件。

显示日期的按钮控件则以动态控件的方式添加。程序运行的界面如下图。


与按钮设置、日期选择等等代码全部放在一个单独的模块中（模块_日历相关)，以方便修改

• 而类模块，“类_日历按钮"中存放的则是与动态添加的按钮控件相关的事件，即将所有按钮的单击事件都指向到“类模块”中指定的过程。
  

• 这样做的好处是，极大地简化了代码。下图为窗体中的所有代码。
  

• 动态控件及事件，也是很简单的，只要掌握了相关的知识，写出来的代码并不复杂。下图为所有类模块中的代码
  

当然，与日历相关的模块中的代码还是比较多的，涉及到控件的添加、设置、修改显示内容等等。

曹先生

前面说过，作为业余爱好者，读别人的代码，有的时候是很累的。
好像每个人编写代码的习惯都不相同，常常是读一段后就不知道一些变量的作用了。所以，我在写这个代码时，尽可能地使用中文标识出一些变量、控件的类型，自己感觉读起来会方便些。当然，肯定会有人觉得这样的代码读起来更累！
好了，言归正传。附件是最后的Excel文件。

charki

曹先生 发表于 2021-4-20 02:53
前面说过，作为业余爱好者，读别人的代码，有的时候是很累的。
好像每个人编写代码的习惯都不相同，常常是 ...

文件异常。。。。压缩包不行。

曹先生

charki 发表于 2021-4-22 09:35
文件异常。。。。压缩包不行。

我下载后也出现了问题！
更见鬼的是，我在电脑上找不到这个文件了！
用“VBA”、“动态”搜索硬盘，竟然没有结果！

opel-wong

看上去不错，留个记号，

曹先生

因为打包下载后出现问题，所以，这里使用最笨的方法，一点点地上传。

• 插入 类模块
  

插入一个类模块，命名为：类_日历按钮

然后复制下面的代码到 类_日历按钮 中

Option Explicit

Private WithEvents 类_日按钮 As MSForms.CommandButton
Attribute 类_日按钮.VB_VarHelpID = -1
'
'初始化，将控件绑定到类
Public Sub Init(ctrl_按钮 As MSForms.CommandButton)
    Set 类_日按钮 = ctrl_按钮
End Sub
'
'控件的Click事件
Private Sub 类_日按钮_Click()
    With 类_日按钮
        '将选中的日期传递给 窗体上的文本框
        窗体_Main.txb_日.Text = .Caption
        Call 模块_日历相关.响应类事件(.Name)
    End With
End Sub
'注销类
Private Sub Class_Terminate()
    Set 类_日按钮 = Nothing
End Sub

• 插入模块
  

插入一个模块，命名为：模块_日历相关"

然后复制下面的代码到 模块_日历相关


Option Explicit

Private 窗体日历控件_日按钮(1 To 42) As 类_日历按钮
'***************** 响应 类 发来的事件的入口 **********************
Public Sub 响应类事件(ByVal str_Name As String)
    Dim int_选中日期 As Integer '记录选中的日期，用于修改年、月后，保持该选中日期
    With 窗体_Main
        '判断是否为本月：不是本月，则要修改 年、月的 复合框内的信息
        '判断依据为字体是否有浅色
        If .Controls(str_Name).ForeColor = 8421504 Then
            '当字体为浅色时，说明所选的为非本月的日期
            int_选中日期 = .Controls(str_Name).Caption
            '非本月日期，可能为上个月，也可能为下个有。
            '以数字的大小来判断是上个月还是下个月。
            If int_选中日期 > 20 Then '此时为上个月
                If .复合框_日历_月 = 1 Then
                    .复合框_日历_月 = 12
                    .复合框_日历_年 = .复合框_日历_年 - 1
                Else
                    .复合框_日历_月 = .复合框_日历_月 - 1
                End If
            Else '此时为下个月
                If .复合框_日历_月 = 12 Then
                    .复合框_日历_月 = 1
                    .复合框_日历_年 = .复合框_日历_年 + 1
                Else
                    .复合框_日历_月 = .复合框_日历_月 + 1
                End If
            End If
            Call 设置背景颜色_选中非本月时(str_Name)
        Else
            Call 设置背景颜色(str_Name)
        End If
    End With
End Sub
'选中非本月后，修改选中日的背景颜色
Private Sub 设置背景颜色_选中非本月时(ByVal str_Name As String)
    Dim int_首日星期 As Integer
    Dim int_位置 As Integer
    '获取本月首日的星期
    With 窗体_Main
        int_首日星期 = Format(.复合框_日历_年 & "/" & .复合框_日历_月 & "/1", "w")  '因为系统默认周日是第一天
    End With
    With 窗体_Main.Controls(str_Name)
        '换年、月前，选中的按钮是深色的。将它恢复为非选中色
        If .ForeColor = 8421504 Then
            .BackColor = vbButtonFace
        Else
            .BackColor = RGB(204, 204, 204)
        End If
    End With
    '将选中的日期的背景设置为深色
    With 窗体_Main
        If int_首日星期 = 2 Then
            int_位置 = int_首日星期 + CInt(.txb_日.Text) + 5
        Else
            int_位置 = int_首日星期 + CInt(.txb_日.Text) - 2
        End If
        .Controls("日" & int_位置).BackColor = -2147483632 '按钮阴影
        .Controls("日" & int_位置).SetFocus '获取焦点
    End With
End Sub
'设置背景颜色
Private Sub 设置背景颜色(ByVal str_Name As String)
    Dim I As Integer
    '根据是否为本月日期，重新设置相关按钮的背景色
    With 窗体_Main
        For I = 1 To 42
            With .Controls("日" & I)
                '判断是否为本月：即 字体颜色是否为浅色
                If .ForeColor = 8421504 Then
                    .BackColor = vbButtonFace
                Else '此时说明字体的颜色不是浅色
                    .BackColor = RGB(204, 204, 204)
                End If
            End With
        Next
        '根据类返回的值，将选中的按钮设置为深色
        .Controls(str_Name).BackColor = -2147483632 '按钮阴影
    End With
End Sub

'================= 模块响应窗体等发来的事件的入口 ==============
Sub Main(ByVal str_Init As String, ByVal int_年 As Integer, ByVal int_月 As Integer)
    Dim I As Integer
    If str_Init = "Yes" Then
        Call 添加日历_日按钮(0)
        Call 添加标签(0)
        '向 复合框_日历_年 加入 年信息
        With 窗体_Main.复合框_日历_年
            For I = 2019 To 2030
                .AddItem I
            Next
            .Value = Year(Date) '设定默认值
        End With
        '向 复合框_日历_月 加入 月信息
        With 窗体_Main.复合框_日历_月
            For I = 1 To 12
                .AddItem Str(I)
            Next
            .Value = Month(Date) '设定默认值
        End With
        Call 设置按钮_显示当前月的日期(int_年, int_月)
    Else
        Call 设置按钮_显示当前月的日期(int_年, int_月)
    End If
End Sub
'

'为按钮设置日期
Private Sub 设置按钮_显示当前月的日期(ByVal int_年 As Integer, ByVal int_月 As Integer)
    Dim int_首日星期 As Integer
    Dim int_本月总天数 As Integer
    Dim int_上月总天数 As Integer
    Dim int_开始写入位置 As Integer
    '获取本月首日的星期
    int_首日星期 = Format(int_年 & "/" & int_月, "w")  '因为系统默认周日是第一天
    '获取本月的总天数
    int_本月总天数 = Format(DateSerial(int_年, int_月 + 1, 1) - 1, "d")
    '获取上月的总天数
    int_上月总天数 = Format(DateSerial(int_年, int_月, 1) - 1, "d")
    '在第一行写入上个月的日期：如果本月的第一天为星期一，则从第二行开始写本月信息
    If int_首日星期 = 2 Then
        int_开始写入位置 = 设置按钮_写入日期(1, 7, int_上月总天数 - 6, "浅")
    Else
        int_开始写入位置 = 设置按钮_写入日期(1, int_首日星期 - 2, int_上月总天数 - int_首日星期 + 3, "浅")
    End If
    '写入本月信息
    int_开始写入位置 = 设置按钮_写入日期(int_开始写入位置, int_开始写入位置 + int_本月总天数 - 1, 1, "")
    '在剩余位置写入下月日期
    Call 设置按钮_写入日期(int_开始写入位置, 42, 1, "浅")
End Sub
'
'为按钮写入日期
Private Function 设置按钮_写入日期(ByVal int_开始位置 As Integer, ByVal int_结束位置 As Integer, ByVal int_开始值 As Integer, ByVal str_色 As String) As Integer
    Dim I As Integer
    For I = int_开始位置 To int_结束位置
        With 窗体_Main.Controls("日" & I)
        'With 窗体_Main.Frame_日期选择.Controls("日" & I)
        '虽然按钮控件添加到了框架中(Frame)，但系统依然认为是窗体内的控件。
        '所以，这里可以省略 “.Frame_日期选择”。
        '开始时并没有意识到这个，所以仍然添加了“.Frame_日期选择”，后来发现了
        '就没有再使用。此处，既然已经写了，就没有删除，而是作为注释标注一下
        '以方便初学者。
            .Caption = int_开始值
            int_开始值 = int_开始值 + 1
            If str_色 = "浅" Then
                .BackColor = vbButtonFace
                .ForeColor = 8421504 '将字体颜色调淡些
            Else
                .BackColor = RGB(204, 204, 204)
                .ForeColor = vbBlack
                '设置字体颜色
                '因为之前曾调淡了非本月的日期的字体颜色
                '所以，当调整年或月时，要重新设置本月的字体颜色
                If I Mod 7 = 6 Then '此时为周六
                    .ForeColor = 32768
                ElseIf I Mod 7 = 0 Then '此时为周日
                    .ForeColor = vbRed '8421631
                Else '此时为工作日
                    .ForeColor = vbBlack
                End If

            End If
        End With
    Next
    设置按钮_写入日期 = I
End Function
'在日历框架中，添加标识星期的标签
Private Sub 添加标签(ByVal int_T As Integer)
    Dim ctrl_标签(1 To 7) As MSForms.Label
    Dim str_星期() ' As String
    Dim I As Integer
    '中文星期
    str_星期 = Array("一", "二", "三", "四", "五", "六", "日")
    With 窗体_Main.Frame_日期选择.Controls
        For I = 1 To 7
            Set ctrl_标签(I) = .Add("Forms.label.1", "lbl_" & I)
            With ctrl_标签(I)
                .Caption = str_星期(I - 1)
                .AutoSize = False
                .BorderStyle = fmBorderStyleSingle
                .BackColor = RGB(204, 204, 204)
                .TextAlign = fmTextAlignCenter
                .Move (I - 1) * 28, 30, 27, 15
                '参数说明：Move [ Left [, Top [, Width [, Height [, Layout ]]]]]
            End With
        Next
        '设置周六和周日的颜色
        ctrl_标签(6).BackColor = 32768
        ctrl_标签(7).BackColor = 8421631
    End With
End Sub
'
Private Sub 添加日历_日按钮(ByVal int_T As Integer)
    Dim I As Integer
    Dim J As Integer
    Dim int_Day As Integer
    Dim ctrl_按钮通用 As MSForms.CommandButton '  通过一个通用的按钮变量，实现动态添加按钮控件
    int_Day = 1
    For I = 1 To 6
        For J = 1 To 7
            '添加按钮控件 到相应窗体的框架(Frame)中
            Set ctrl_按钮通用 = 窗体_Main.Frame_日期选择.Controls.Add("Forms.CommandButton.1", "日" & int_Day)
            '语法：Set Control = object.controls.Add(ProgID [, Name [, Visible ]] )
            '语法：Set 控件名 = 对象（这里是容器，如窗体、框架等). Add(“ProgID为VBA常量，可查看微软帮助信息”, “Name最好不要省略，以方便在代码中调用”）
            '使用下述代码亦可正常运行，原因不详！
            'Set ctrl_按钮通用 = 窗体_Main.Frame_日期选择.Controls.Add("Forms.CommandButton.1", "日" & Str(int_Day))
            '设置按钮控件标题和位置
            With ctrl_按钮通用
                .Caption = int_Day
                .Move (J - 1) * 28, (I - 1) * 23 + 45, 28, 21
                '参数说明：Move [ Left [, Top [, Width [, Height [, Layout ]]]]]
                '设置周六和周日字体颜色
                If J = 6 Then
                    .ForeColor = 32768
                ElseIf J = 7 Then
                    .ForeColor = 128
                End If
            End With
            '创建cCB类实例
            Set 窗体日历控件_日按钮(int_Day) = New 类_日历按钮
            '将控件赋给类实例
            窗体日历控件_日按钮(int_Day).Init ctrl_按钮通用
            '最后为 int_Day 赋新值
            int_Day = int_Day + 1
        Next
    Next
End Sub

曹先生

• 窗体：
  

新建一个窗体，然后写入下面的代码：
Option Explicit

Private Sub cmd_End_Click()
    End
End Sub

Private Sub UserForm_Initialize()
    Dim int_年 As Integer
    Dim int_月 As Integer
    int_年 = Year(Date)
    int_月 = Month(Date)
    Call 模块_日历相关.Main("Yes", int_年, int_月)
End Sub

Private Sub 复合框_日历_年_Change()
    With Me.Frame_日期选择
        Call 模块_日历相关.Main("No", .复合框_日历_年.Value, .复合框_日历_月.Value)
    End With
End Sub

Private Sub 复合框_日历_月_Change()
    With Me.Frame_日期选择
        Call 模块_日历相关.Main("No", .复合框_日历_年.Value, .复合框_日历_月.Value)
    End With
End Sub


窗体上的控件，请根据上述代码及第3楼的图片，自己添加和修改名称。

曹先生

我以前写的另一个帖子：Excel VBA业余爱好者学习心得及总结-Excel VBA程序开发-ExcelHome技术论坛 -

有人让我上传文件，最近上传了，也不清楚是否会出现这个帖子的情况。等有反馈的时候再说吧，懒得检查了。