ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

搜索
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 Excel Home精品图文教程库
HR薪酬管理数字化实战 Excel 2021函数公式学习大典 Excel数据透视表实战秘技 打造核心竞争力的职场宝典
300集Office 2010微视频教程 数据工作者的案头书 免费直播课集锦 ExcelHome出品 - VBA代码宝免费下载
用ChatGPT与VBA一键搞定Excel WPS表格从入门到精通 Excel VBA经典代码实践指南
查看: 4973|回复: 17

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

[复制链接]

TA的精华主题

TA的得分主题

发表于 2021-4-20 02:20 | 显示全部楼层 |阅读模式
在工作中,使用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.htmlhttp://club.excelhome.net/thread-1443945-1-1.html 。 还有其它的,例举的不全)。
下载了两个,真是佩服作者的思路!尤其是有一个还能显示农历。
这些文件都是在窗体上直接添加了按钮控件,日期的相关控件是42个,代码更是密密麻麻的一大堆。我的水平有限,读这些代码感觉头痛。在使用过程,还要重新调整控件的大小和位置等等,感觉好累。
这些作者给我提供了一个极好的思路,即使用微软最基本的控件去模拟日历控件。
为了避免大量的代码,决定使用动态控件数组。自己以前从来没有做过这样的事情,于是在网上查了一下,这个文章给了我极大的帮助:http://www.360doc.com/content/10/0112/14/406571_13343606.shtml

TA的精华主题

TA的得分主题

 楼主| 发表于 2021-4-20 02:25 | 显示全部楼层
这是下载的一个非常好的VBA程序,只是代码太多了,密密麻麻的,看着头大!
001.png

002.png

TA的精华主题

TA的得分主题

 楼主| 发表于 2021-4-20 02:40 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
本帖最后由 曹先生 于 2021-4-20 07:34 编辑

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

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

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

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

004.png

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

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

005.png

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

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

TA的精华主题

TA的得分主题

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

VBA_动态控件数组_模拟微软日历.rar

35.8 KB, 下载次数: 412

评分

1

查看全部评分

TA的精华主题

TA的得分主题

发表于 2021-4-22 09:35 来自手机 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
曹先生 发表于 2021-4-20 02:53
前面说过,作为业余爱好者,读别人的代码,有的时候是很累的。
好像每个人编写代码的习惯都不相同,常常是 ...

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

TA的精华主题

TA的得分主题

 楼主| 发表于 2021-4-22 10:04 | 显示全部楼层
charki 发表于 2021-4-22 09:35
文件异常。。。。压缩包不行。

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

TA的精华主题

TA的得分主题

发表于 2021-4-22 10:33 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
看上去不错,留个记号,

TA的精华主题

TA的得分主题

 楼主| 发表于 2021-4-22 11:14 | 显示全部楼层
因为打包下载后出现问题,所以,这里使用最笨的方法,一点点地上传。

  • 插入 类模块


插入一个类模块,命名为:类_日历按钮

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

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


TA的精华主题

TA的得分主题

 楼主| 发表于 2021-4-22 11:21 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
  • 窗体:

新建一个窗体,然后写入下面的代码:
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楼的图片,自己添加和修改名称。


TA的精华主题

TA的得分主题

 楼主| 发表于 2021-4-22 11:23 | 显示全部楼层
我以前写的另一个帖子:Excel VBA业余爱好者学习心得及总结-Excel VBA程序开发-ExcelHome技术论坛 -

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

您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2024-3-29 21:06 , Processed in 0.047235 second(s), 11 queries , Gzip On, Redis On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

沪公网安备 31011702000001号 沪ICP备11019229号-2

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:李志群律师

快速回复 返回顶部 返回列表