VBA学习(22):动态显示日历

 这是在ozgrid.com论坛上看到的一个贴子,很有意思,本来使用公式是可以很方便在工作表中实现日历显示的,但提问者因其需要,想使用VBA实现动态显示日历,即根据输入的年份和月份在工作表中显示日历。

下面是实现该效果的VBA程序,我稍微进行了一些调整和注释,供学习参考。

Sub CalendarMaker()Dim MyInput As StringDim StartDay As LongDim DayofWeek As LongDim CurYear As LongDim CurMonth As LongDim FinalDay As LongDim cellAs RangeDim RowCell As LongDim ColCell As LongDim x As Long' 如果之前存在日历,取消保护工作表以Sub CalendarMaker()Dim MyInput As StringDim StartDay As LongDim DayofWeek As LongDim CurYear As LongDim CurMonth As LongDim FinalDay As LongDim cell As RangeDim RowCell As LongDim ColCell As LongDim x As Long' 如果之前存在日历,取消保护工作表以避免错误.ActiveSheet.Protect DrawingObjects:=False, Contents:=False, Scenarios:=False'关闭屏幕刷新.Application.ScreenUpdating = False' 设置错误捕捉.On Error GoTo MyErrorTrap' 清除包括之前的日历的单元格区域A1:G14.Range("A1:G14").Clear' 使用InputBox来获取想要显示的年和月份并赋给变量MyInput.MyInput = InputBox("输入要显示日历的年和月,例如2021-3,2021-3-25.")' 允许用户使用输入框中的取消按钮结束宏.If MyInput = "" Then Exit Sub' 获取输入的月初日期值.StartDay = DateValue(MyInput)' 检查是否为有效日期但不是该月的第一天' -- 如果是, 重新设置StartDay为该月的第一天.If Day(StartDay) <> 1 ThenStartDay = DateValue(Month(StartDay) & "/1/" & Year(StartDay))End If' 根据输入为月份和年份准备单元格.Range("A1").NumberFormat = "yyyy""年""m""月"""' 跨A1:G1居中年份和月份标签并使用合适的字体和行高.With Range("A1:G1").HorizontalAlignment = xlCenterAcrossSelection.VerticalAlignment = xlCenter.Font.Size = 18.Font.Bold = True.RowHeight = 35End With' 准备A2:G2为星期标签并使其居中以及合适的字体和高度.With Range("A2:G2").ColumnWidth = 11.VerticalAlignment = xlCenter.HorizontalAlignment = xlCenter.VerticalAlignment = xlCenter.Orientation = xlHorizontal.Font.Size = 12.Font.Bold = True.RowHeight = 20End With' 在A2:G2中放置星期标签.Range("A2") = "星期日"Range("B2") = "星期一"Range("C2") = "星期二"Range("D2") = "星期三"Range("E2") = "星期四"Range("F2") = "星期五"Range("G2") = "星期六"' 准备A3:G8为日期并使其居于右上角以及合适的字体和高度.With Range("A3:G8").HorizontalAlignment = xlRight.VerticalAlignment = xlTop.Font.Size = 18.Font.Bold = True.RowHeight = 21End With' 将输入的年份和月份完整拼写到"A1".Range("A1").Value = Application.Text(MyInput, "yyyy""年""m""月""")' 设置变量并获取该月开始的星期几.DayofWeek = Weekday(StartDay)' 设置变量来保存识别的年份和月份.CurYear = Year(StartDay)CurMonth = Month(StartDay)' 设置变量来保存下月的第一天.FinalDay = DateSerial(CurYear, CurMonth + 1, 1)' 基于DayofWeek为所选月的第一天的单元格位置输入"1".Select Case DayofWeekCase 1Range("A3").Value = 1Case 2Range("B3").Value = 1Case 3Range("C3").Value = 1Case 4Range("D3").Value = 1Case 5Range("E3").Value = 1Case 6Range("F3").Value = 1Case 7Range("G3").Value = 1End Select' 遍历单元格区域A3:G8每个单元格在之前的单元格之上加"1".For Each cell In Range("A3:G8")RowCell = cell.RowColCell = cell.Column'如果"1"在第1列.If cell.Column = 1 And cell.Row = 3 Then' 如果当前单元格不在第1列.ElseIf cell.Column <> 1 ThenIf cell.Offset(0, -1).Value >= 1 Thencell.Value = cell.Offset(0, -1).Value + 1' 当该月的最后一天被输入则停止.If cell.Value > (FinalDay - StartDay) Thencell.Value = ""' 当日历有正确的天数显示则退出循环.Exit ForEnd IfEnd If' 如果当前单元格不在第3行且在第1列.ElseIf cell.Row > 3 And cell.Column = 1 Thencell.Value = cell.Offset(-1, 6).Value + 1' 当该月最后一天被输入则停止.If cell.Value > (FinalDay - StartDay) Thencell.Value = ""' 当日历有正确的天数显示则退出循环.Exit ForEnd IfEnd IfNext' 创建条目单元格, 将其格式化为居中, 文本换行及添加边框.For x = 0 To 5Range("A4").Offset(x * 2, 0).EntireRow.InsertWith Range("A4:G4").Offset(x * 2, 0).RowHeight = 65.HorizontalAlignment = xlCenter.VerticalAlignment = xlTop.WrapText = True.Font.Size = 10.Font.Bold = False' 解锁这些单元格,以便在工作表受保护之后可以输入文本..Locked = FalseEnd With' 在日期周围设置边框.With Range("A3").Offset(x * 2, 0).Resize(2, 7).Borders(xlLeft).Weight = xlThick.ColorIndex = xlAutomaticEnd WithWith Range("A3").Offset(x * 2, 0).Resize(2, 7).Borders(xlRight).Weight = xlThick.ColorIndex = xlAutomaticEnd WithRange("A3").Offset(x * 2, 0).Resize(2, 7).BorderAround Weight:=xlThick, ColorIndex:=xlAutomaticNextIf Range("A13").Value = "" Then Range("A13").Offset(0, 0).Resize(2, 8).EntireRow.Delete' 关闭网格线显示.ActiveWindow.DisplayGridlines = False' 保护工作表以避免覆盖日期.ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True' 重新设置窗口大小显示所有日历.ActiveWindow.WindowState = xlMaximizedActiveWindow.ScrollRow = 1' 打开屏幕刷新.Application.ScreenUpdating = True' 避免进入错误处理.Exit Sub' 错误处理.
MyErrorTrap:MsgBox "你可能没有正确地输入年份和月份." & Chr(13) & "正确地拼写月份" _& " (或使用3字母缩写)" _& Chr(13) & "年份使用4个数字."MyInput = InputBox("输入要显示日历的年和月,例如2021-3,2021-3-25.")If MyInput = "" Then Exit SubResume
End Sub避免错误.ActiveSheet.Protect DrawingObjects:=False, Contents:=False,Scenarios:=False'关闭屏幕刷新.Application.ScreenUpdating = False' 设置错误捕捉.On Error GoTo MyErrorTrap' 清除包括之前的日历的单元格区域A1:G14.Range("A1:G14").Clear' 使用InputBox来获取想要显示的年和月份并赋给变量MyInput.MyInput =InputBox("输入要显示日历的年和月,例如2021-3,2021-3-25.")' 允许用户使用输入框中的取消按钮结束宏.If MyInput = "" Then Exit Sub' 获取输入的月初日期值.StartDay= DateValue(MyInput)' 检查是否为有效日期但不是该月的第一天' -- 如果是, 重新设置StartDay为该月的第一天.If Day(StartDay) <> 1 ThenStartDay = DateValue(Month(StartDay) & "/1/" &Year(StartDay))End If' 根据输入为月份和年份准备单元格.Range("A1").NumberFormat = "yyyy""年""m""月"""' 跨A1:G1居中年份和月份标签并使用合适的字体和行高.With Range("A1:G1").HorizontalAlignment = xlCenterAcrossSelection.VerticalAlignment = xlCenter.Font.Size = 18.Font.Bold = True.RowHeight = 35End With' 准备A2:G2为星期标签并使其居中以及合适的字体和高度.With Range("A2:G2").ColumnWidth = 11.VerticalAlignment = xlCenter.HorizontalAlignment = xlCenter.VerticalAlignment = xlCenter.Orientation = xlHorizontal.Font.Size = 12.Font.Bold= True.RowHeight = 20End With' 在A2:G2中放置星期标签.Range("A2") = "星期日"Range("B2") = "星期一"Range("C2") = "星期二"Range("D2") = "星期三"Range("E2") = "星期四"Range("F2") = "星期五"Range("G2") = "星期六"' 准备A3:G8为日期并使其居于右上角以及合适的字体和高度.With Range("A3:G8").HorizontalAlignment = xlRight.VerticalAlignment = xlTop.Font.Size = 18.Font.Bold = True.RowHeight = 21End With' 将输入的年份和月份完整拼写到"A1".Range("A1").Value= Application.Text(MyInput, "yyyy""年""m""月""")' 设置变量并获取该月开始的星期几.DayofWeek= Weekday(StartDay)' 设置变量来保存识别的年份和月份.CurYear =Year(StartDay)CurMonth= Month(StartDay)' 设置变量来保存下月的第一天.FinalDay= DateSerial(CurYear, CurMonth + 1, 1)' 基于DayofWeek为所选月的第一天的单元格位置输入"1".Select Case DayofWeekCase 1Range("A3").Value = 1Case 2Range("B3").Value = 1Case 3Range("C3").Value = 1Case 4Range("D3").Value = 1Case 5Range("E3").Value = 1Case 6Range("F3").Value = 1Case 7Range("G3").Value = 1End Select' 遍历单元格区域A3:G8每个单元格在之前的单元格之上加"1".For Each cell In Range("A3:G8")RowCell = cell.RowColCell = cell.Column'如果"1"在第1列.If cell.Column = 1 And cell.Row = 3 Then' 如果当前单元格不在第1列.ElseIf cell.Column <> 1 ThenIf cell.Offset(0, -1).Value >= 1 Thencell.Value = cell.Offset(0, -1).Value + 1' 当该月的最后一天被输入则停止.If cell.Value > (FinalDay - StartDay) Thencell.Value = ""' 当日历有正确的天数显示则退出循环.Exit ForEnd IfEnd If' 如果当前单元格不在第3行且在第1列.ElseIf cell.Row > 3 And cell.Column =1 Thencell.Value = cell.Offset(-1, 6).Value + 1' 当该月最后一天被输入则停止.If cell.Value > (FinalDay - StartDay) Thencell.Value = ""' 当日历有正确的天数显示则退出循环.Exit ForEnd IfEnd IfNext' 创建条目单元格, 将其格式化为居中, 文本换行及添加边框.For x = 0To 5Range("A4").Offset(x * 2, 0).EntireRow.InsertWith Range("A4:G4").Offset(x * 2, 0).RowHeight = 65.HorizontalAlignment = xlCenter.VerticalAlignment = xlTop.WrapText = True.Font.Size = 10.Font.Bold = False' 解锁这些单元格,以便在工作表受保护之后可以输入文本..Locked = FalseEnd With' 在日期周围设置边框.With Range("A3").Offset(x * 2, 0).Resize(2, 7).Borders(xlLeft).Weight = xlThick.ColorIndex = xlAutomaticEnd WithWith Range("A3").Offset(x * 2, 0).Resize(2, 7).Borders(xlRight).Weight = xlThick.ColorIndex = xlAutomaticEnd WithRange("A3").Offset(x * 2, 0).Resize(2, 7).BorderAroundWeight:=xlThick, ColorIndex:=xlAutomaticNextIf Range("A13").Value = "" Then Range("A13").Offset(0, 0).Resize(2, 8).EntireRow.Delete' 关闭网格线显示.ActiveWindow.DisplayGridlines = False' 保护工作表以避免覆盖日期.ActiveSheet.Protect DrawingObjects:=True, Contents:=True,Scenarios:=True' 重新设置窗口大小显示所有日历.ActiveWindow.WindowState = xlMaximizedActiveWindow.ScrollRow = 1' 打开屏幕刷新.Application.ScreenUpdating = True' 避免进入错误处理.Exit Sub' 错误处理.
MyErrorTrap:MsgBox"你可能没有正确地输入年份和月份."_&Chr(13) & "正确地拼写月份" _&" (或使用3字母缩写)" _&Chr(13) & "年份使用4个数字."MyInput =InputBox("输入要显示日历的年和月,例如2021-3,2021-3-25.")If MyInput = "" Then Exit SubResume
End Sub

技术交流,软件开发,欢迎加xwlink1996 


作者其他作品:

VBA实战(Excel)(1):提升运行速度

Ribbon第一节:控件大全

HTML实战(1):新建一个HTML

VB.net实战(VSTO):Excel插件的安装与卸载

 

本文来自互联网用户投稿,该文观点仅代表作者本人,不代表本站立场。本站仅提供信息存储空间服务,不拥有所有权,不承担相关法律责任。如若转载,请注明出处:http://www.rhkb.cn/news/392824.html

如若内容造成侵权/违法违规/事实不符,请联系长河编程网进行投诉反馈email:809451989@qq.com,一经查实,立即删除!

相关文章

喜报!DAP-seq文章6连发,总IF 95.2

2024年4月29日&#xff0c;河北农业大学林学院李保国山区产业开发与林果产业创新团队与园艺学院田义教授团队联合西北农林科技大学马锋旺教授团队及沈阳农业大学马跃教授团队在Plant Biotechnology Journal&#xff08;影响因子10.1&#xff09;上发表了题为“The MdVQ37-MdWRK…

2024最新版Python基础入门学习路线

Python基础入门学习路线可以概括为以下几个阶段&#xff0c;每个阶段都包含了关键的学习内容和目标&#xff1a; 一、Python语言基础 1. 初识Python语言 Python语言概述&#xff1a;了解Python的起源、特点、应用领域以及发展趋势。环境安装&#xff1a;学习如何在不同的操作系…

18987 随机数(测验)

这个问题可以通过使用集合&#xff08;set&#xff09;和排序来解决。集合是一种数据结构&#xff0c;它可以自动去除重复的元素。然后我们可以将集合中的元素转移到一个数组中&#xff0c;并对&#xfffd;&#xfffd;组进行排序。 以下是使用C的代码实现&#xff1a; #i…

浅谈哈希与哈希表(c++)

目录 一、哈希的基本概念&#xff08;一&#xff09;哈希函数的特性&#xff08;二&#xff09;哈希冲突 二、C 中的哈希表实现三、哈希表的性能分析四、哈希表的应用场景五、优化哈希表的策略六、例题讲解【模板】字符串哈希题目描述输入格式输出格式样例 #1样例输入 #1样例输…

工业5G路由器赋能户外组网远程监控及预警

随着物联网、大数据、云计算等技术的快速发展&#xff0c;工业领域对于远程监控、实时预警和数据传输的需求日益增长。特别是在户外复杂环境下&#xff0c;传统的有线网络组网方式面临着布线难度大、成本高、维护困难等问题。 工业5G路由器在户外组网远程监控预警应用基于高速…

Android开发之事件分发

#来自ウルトラマンゼロ&#xff08;哉阿斯&#xff09; 1 Activity 构成 平常布局展示在ContentView中。 2 事件分发 事件分发的本质其实就是把事件&#xff08;Touch&#xff09;封装成 MotionEvent 类&#xff0c;然后传递给 View 的层级处理。 MotionEvent 事件类型主要有…

RAG与Fine Tuning:如何选择正确的方法

今日份知识你摄入了么&#xff1f; 生成式人工智能有潜力改变你的业务和数据工程团队&#xff0c;但前提是要正确实施。那么&#xff0c;你的数据团队如何才能真正利用大型语言模型或生成式人工智能_&#xff08;GenAI&#xff09;_计划来驱动价值呢&#xff1f; 领先的组织通…

我在高职教STM32——I2C通信入门(1)

大家好,我是老耿,高职青椒一枚,一直从事单片机、嵌入式、物联网等课程的教学。对于高职的学生层次,同行应该都懂的,老师在课堂上教学几乎是没什么成就感的。正是如此,才有了借助CSDN平台寻求认同感和成就感的想法。在这里,我准备陆续把自己花了很多心思设计的教学课件分…

Sentinel-1 Level 1数据处理的详细算法定义(五)

《Sentinel-1 Level 1数据处理的详细算法定义》文档定义和描述了Sentinel-1实现的Level 1处理算法和方程,以便生成Level 1产品。这些算法适用于Sentinel-1的Stripmap、Interferometric Wide-swath (IW)、Extra-wide-swath (EW)和Wave模式。 今天介绍的内容如下: Sentinel-1 L…

Python爬虫新手指南及简单实战

网络爬虫是自动化获取网络信息的高效工具&#xff0c;Python因其强大的库支持和简洁的语法成为编写网络爬虫的首选语言。本教程将通过一个具体的案例&#xff08;基于Microsoft Edge浏览器的简单爬取&#xff09;&#xff0c;指导你使用Python实现一个完整的网络爬虫&#xff0…

NIO专题学习(一)

一、BIO/NIO/AIO介绍 1. 背景说明 在Java的软件设计开发中&#xff0c;通信架构是不可避免的。我们在进行不同系统或者不同进程之间的数据交互&#xff0c;或者在高并发的通信场景下都需要用到网络通信相关的技术。 对于一些经验丰富的程序员来说&#xff0c;Java早期的网络…

PXE 服务器搭建——启动界面设计实验

环境准备&#xff1a; 前期准备&#xff1a; 解决 kickstart 实验出现的 DHCP 的问题-CSDN博客 http://t.csdnimg.cn/5vZP0 当前准备&#xff1a; 两台虚拟机&#xff1a;RHEL7 OpenEuler(作为测试机器使用) ip&#xff1a;172.25.254.100 yum install syslinux.x…

【Web开发手礼】探索Web开发的秘密(十五)-Vue2(2)AJAX、前后端分离、前端工程化

主要介绍了AJAX、前后端分离所需的YApi、前端工程化所需要的环境安装&#xff01;&#xff01;&#xff01; 目录 前言 AJAX ​原生Ajax Axios Axios入门 案例 前后端分离开发 YApi ​前端工程化 环境准备 总结 前言 主要介绍了AJAX、前后端分离所需的YApi、前端工…

2024华数杯c题题解(一)

目录 原题背景 背景分析 问题一 思路 代码 问题二 思路 代码 原题背景 最近&#xff0c;“city 不 city”这一网络流行语在外国网红的推动下备受关注。随着我国过境免签政策的落实&#xff0c;越来越多外国游客来到中国&#xff0c;通过网络平台展示他们在华旅行的见闻…

出现 No mapping for DELETE/GET等

出现 No mapping for DELETE/GET等 错误一&#xff1a;请求url不对 修改前 如下图可知后端请求url为http://localhost:8080/user/addressBook 运行后控制台出现 发现后端请求url比前端请求url少了/ 改正&#xff1a; 在DeleteMapping后面加上 / DeleteMapping("/&quo…

mysql操作(进阶)

1.数据库约束 数据库自动对数据的合法性进行校验检查的一系列机制&#xff0c;目的是为了保证数据库中能够避免被插入或者修改一些非法数据。 &#xff08;1&#xff09;mysql中提供了以下的约束&#xff1a; a.NOT NULL&#xff1a;指定某列不能为null b.UNIQUE&#xff1…

搭建pxe网络安装环境实现服务器自动部署

目录 配置 kickstart自动安装脚本 搭建dhcp服务 搭建pxe网络安装环境实现服务器自动部署 测试 配置 kickstart自动安装脚本 yum install system-config-kickstart #在rhel7做&#xff0c;rhel9要收费 system-config-kickstart #启动图形制作工具 vim …

工具收集 - tinytask(相当于迷你的按键精灵)

工具收集 - tinytask&#xff08;相当于迷你的按键精灵&#xff09; 简介首页 简介 TinyTask 是一款极简主义的 PC 自动化应用程序&#xff0c;您可以用它来记录和重复操作。顾名思义&#xff0c;它小得令人难以置信&#xff08;仅 36KB&#xff01;&#xff09;&#xff0c;极…

C++第三十一弹---C++继承机制深度剖析(下)

✨个人主页&#xff1a; 熬夜学编程的小林 &#x1f497;系列专栏&#xff1a; 【C语言详解】 【数据结构详解】【C详解】 1.菱形继承及菱形虚拟继承 1.1 单继承 单继承&#xff1a;一个子类只有一个直接父类时称这个继承关系为单继承。 Student的直接父类是Person&#xff…

openai command not found (mac)

题意&#xff1a;mac 系统上无法识别 openai 的命令 问题背景&#xff1a; Im trying to follow the fine tuning guide for Openai here. 我正在尝试遵循 OpenAI 的微调指南 I ran: 我运行以下命令 pip install --upgrade openaiWhich install without any errors.…