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

news2024/9/22 15:49:27

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

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

Sub CalendarMaker()
    Dim MyInput As String
    Dim StartDay As Long
    Dim DayofWeek As Long
    Dim CurYear As Long
    Dim CurMonth As Long
    Dim FinalDay As Long
    Dim cellAs Range
    Dim RowCell As Long
    Dim ColCell As Long
    Dim x As Long
 
   ' 如果之前存在日历,取消保护工作表以Sub CalendarMaker()
    Dim MyInput As String
    Dim StartDay As Long
    Dim DayofWeek As Long
    Dim CurYear As Long
    Dim CurMonth As Long
    Dim FinalDay As Long
    Dim cell As Range
    Dim RowCell As Long
    Dim ColCell As Long
    Dim 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 Then
       StartDay = 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 = 35
    End With
   ' 准备A2:G2为星期标签并使其居中以及合适的字体和高度.
    With Range("A2:G2")
       .ColumnWidth = 11
       .VerticalAlignment = xlCenter
       .HorizontalAlignment = xlCenter
       .VerticalAlignment = xlCenter
       .Orientation = xlHorizontal
       .Font.Size = 12
        .Font.Bold = True
       .RowHeight = 20
    End 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 = 21
    End 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 DayofWeek
    Case 1
       Range("A3").Value = 1
    Case 2
       Range("B3").Value = 1
    Case 3
       Range("C3").Value = 1
    Case 4
       Range("D3").Value = 1
    Case 5
       Range("E3").Value = 1
    Case 6
       Range("F3").Value = 1
    Case 7
       Range("G3").Value = 1
    End Select
   ' 遍历单元格区域A3:G8每个单元格在之前的单元格之上加"1".
    For Each cell In Range("A3:G8")
       RowCell = cell.Row
       ColCell = cell.Column
        '如果"1"在第1列.
        If cell.Column = 1 And cell.Row = 3 Then
        ' 如果当前单元格不在第1列.
       ElseIf cell.Column <> 1 Then
           If cell.Offset(0, -1).Value >= 1 Then
               cell.Value = cell.Offset(0, -1).Value + 1
                ' 当该月的最后一天被输入则停止.
               If cell.Value > (FinalDay - StartDay) Then
                   cell.Value = ""
                    ' 当日历有正确的天数显示则退出循环.
                   Exit For
               End If
           End If
        ' 如果当前单元格不在第3行且在第1列.
        ElseIf cell.Row > 3 And cell.Column = 1 Then
           cell.Value = cell.Offset(-1, 6).Value + 1
            ' 当该月最后一天被输入则停止.
           If cell.Value > (FinalDay - StartDay) Then
               cell.Value = ""
                ' 当日历有正确的天数显示则退出循环.
               Exit For
           End If
        End If
    Next
   ' 创建条目单元格, 将其格式化为居中, 文本换行及添加边框.
    For x = 0 To 5
       Range("A4").Offset(x * 2, 0).EntireRow.Insert
        With Range("A4:G4").Offset(x * 2, 0)
           .RowHeight = 65
           .HorizontalAlignment = xlCenter
           .VerticalAlignment = xlTop
           .WrapText = True
           .Font.Size = 10
           .Font.Bold = False
            ' 解锁这些单元格,以便在工作表受保护之后可以输入文本.
           .Locked = False
        End With
        ' 在日期周围设置边框.
        With Range("A3").Offset(x * 2, 0).Resize(2, 7).Borders(xlLeft)
           .Weight = xlThick
           .ColorIndex = xlAutomatic
        End With
        With Range("A3").Offset(x * 2, 0).Resize(2, 7).Borders(xlRight)
            .Weight = xlThick
           .ColorIndex = xlAutomatic
        End With
        Range("A3").Offset(x * 2, 0).Resize(2, 7).BorderAround Weight:=xlThick, ColorIndex:=xlAutomatic
    Next
    If 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 = xlMaximized
   ActiveWindow.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 Sub
    Resume
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 Then
       StartDay = 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 = 35
    End With
   ' 准备A2:G2为星期标签并使其居中以及合适的字体和高度.
    With Range("A2:G2")
       .ColumnWidth = 11
       .VerticalAlignment = xlCenter
       .HorizontalAlignment = xlCenter
       .VerticalAlignment = xlCenter
       .Orientation = xlHorizontal
       .Font.Size = 12
        .Font.Bold= True
       .RowHeight = 20
    End 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 = 21
    End 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 DayofWeek
    Case 1
       Range("A3").Value = 1
    Case 2
       Range("B3").Value = 1
    Case 3
       Range("C3").Value = 1
    Case 4
       Range("D3").Value = 1
    Case 5
       Range("E3").Value = 1
    Case 6
       Range("F3").Value = 1
    Case 7
       Range("G3").Value = 1
    End Select
   ' 遍历单元格区域A3:G8每个单元格在之前的单元格之上加"1".
    For Each cell In Range("A3:G8")
       RowCell = cell.Row
       ColCell = cell.Column
        '如果"1"在第1列.
        If cell.Column = 1 And cell.Row = 3 Then
        ' 如果当前单元格不在第1列.
       ElseIf cell.Column <> 1 Then
           If cell.Offset(0, -1).Value >= 1 Then
               cell.Value = cell.Offset(0, -1).Value + 1
                ' 当该月的最后一天被输入则停止.
               If cell.Value > (FinalDay - StartDay) Then
                   cell.Value = ""
                    ' 当日历有正确的天数显示则退出循环.
                   Exit For
               End If
           End If
        ' 如果当前单元格不在第3行且在第1列.
        ElseIf cell.Row > 3 And cell.Column =1 Then
           cell.Value = cell.Offset(-1, 6).Value + 1
            ' 当该月最后一天被输入则停止.
           If cell.Value > (FinalDay - StartDay) Then
               cell.Value = ""
                ' 当日历有正确的天数显示则退出循环.
               Exit For
           End If
        End If
    Next
   ' 创建条目单元格, 将其格式化为居中, 文本换行及添加边框.
    For x = 0To 5
       Range("A4").Offset(x * 2, 0).EntireRow.Insert
        With Range("A4:G4").Offset(x * 2, 0)
           .RowHeight = 65
           .HorizontalAlignment = xlCenter
           .VerticalAlignment = xlTop
           .WrapText = True
           .Font.Size = 10
           .Font.Bold = False
            ' 解锁这些单元格,以便在工作表受保护之后可以输入文本.
           .Locked = False
        End With
        ' 在日期周围设置边框.
        With Range("A3").Offset(x * 2, 0).Resize(2, 7).Borders(xlLeft)
           .Weight = xlThick
           .ColorIndex = xlAutomatic
        End With
        With Range("A3").Offset(x * 2, 0).Resize(2, 7).Borders(xlRight)
            .Weight = xlThick
           .ColorIndex = xlAutomatic
        End With
       Range("A3").Offset(x * 2, 0).Resize(2, 7).BorderAroundWeight:=xlThick, ColorIndex:=xlAutomatic
    Next
    If 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 = xlMaximized
   ActiveWindow.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 Sub
    Resume
End Sub

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

作者其他作品：

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

Ribbon第一节：控件大全

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

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

 

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

如若内容造成侵权/违法违规/事实不符，请联系多彩编程网进行投诉反馈，一经查实，立即删除！

相关文章

web、nginx

web、nginx

一、web基本概念和常识 ■ Web:为用户提供的一种在互联网上浏览信息的服务,Web服务是动态的、可交互的、跨平台的和图形化的。 ■ Web 服务为用户提供各种互联网服务,这些服务包括信息浏览服务,以及各种交互式服务,包括聊天、购物、学习等等内容。 ■ Web 应用开发也经过了几…
阅读更多...
C#中计算矩阵(数学库下载和安装)

C#中计算矩阵(数学库下载和安装)

1、一步步建立一个C#项目 一步步建立一个C#项目(连续读取S7-1200PLC数据)_s7协议批量读取-CSDN博客文章浏览阅读1.7k次&#xff0c;点赞2次&#xff0c;收藏4次。这篇博客作为C#的基础系列&#xff0c;和大家分享如何一步步建立一个C#项目完成对S7-1200PLC数据的连续读取。首先…
阅读更多...
如何解决C#字典的线程安全问题

如何解决C#字典的线程安全问题

前言 我们在上位机软件开发过程中经常需要使用字典这个数据结构&#xff0c;并且经常会在多线程环境中使用字典&#xff0c;如果使用常规的Dictionary就会出现各种异常&#xff0c;本文就是详细介绍如何在多线程环境中使用字典来解决线程安全问题。 1、非线程安全举例 Dictio…
阅读更多...
文件搜索 36

文件搜索 36

删除文件 文件搜索 package File;import java.io.File;public class file3 {public static void main(String[] args) {search(new File("D :/"), "qq");}/*** 去目录搜索文件* param dir 目录* param filename 要搜索的文件名称*/public static void sear…
阅读更多...
探索Prefect：Python自动化的终极武器

探索Prefect：Python自动化的终极武器

文章目录 探索Prefect&#xff1a;Python自动化的终极武器背景&#xff1a;自动化的呼唤Prefect&#xff1a;自动化的瑞士军刀安装Prefect&#xff1a;一键启动基础用法&#xff1a;Prefect的五招场景应用&#xff1a;Prefect的实战演练常见问题&#xff1a;Prefect的故障排除总…
阅读更多...
字节一面面经

字节一面面经

1.redis了解吗&#xff0c;是解决什么问题的&#xff0c;redis的应用&#xff1f; Redis 是一种基于内存的数据库&#xff0c;常用的数据结构有string、hash、list、set、zset这五种&#xff0c;对数据的读写操作都是在内存中完成。因此读写速度非常快&#xff0c;常用于缓存&…
阅读更多...
IDEA的疑难杂症

IDEA的疑难杂症

注意idea版本是否与maven版本兼容 2019idea与maven3.6以上不兼容 IDEA无法启动 打开idea下载安装的目录&#xff1a;如&#xff1a;Idea\IntelliJ IDEA 2024.1\bin 在bin下面找到 打开在最后一行添加暂停 pause 之后双击运行idea.bat 提示找不到一个jar包&#xff0c;…
阅读更多...
MyBatis 框架的两大缺点及解决方案

MyBatis 框架的两大缺点及解决方案

MyBatis 框架的两大缺点及解决方案 1. SQL 编写负担重1.1 缺点概述1.2 解决方案 2. 数据库移植性差2.1 缺点概述2.2 解决方案 &#x1f496;The Begin&#x1f496;点点关注&#xff0c;收藏不迷路&#x1f496; MyBatis 作为一款广受欢迎的 Java 持久层框架&#xff0c;尽管其…
阅读更多...
ssh 显示图形化界面 Error: Can‘t open display

ssh 显示图形化界面 Error: Can‘t open display

在客户端&#xff08;你自己的电脑&#xff0c;不是服务器&#xff09;安装 VcXsrv 直接从 github 上下载 https://github.com/marchaesen/vcxsrv/releases&#xff0c;或者使用 winget 命令 winget install -i vcxsrv在服务器上 ~/.zshrc 中&#xff08;或 ~/.bashrc&#xf…
阅读更多...
【ubuntu系统】在虚拟机内安装Ubuntu

【ubuntu系统】在虚拟机内安装Ubuntu

Ubuntu系统装机 描述新装机后的常规配置&#xff0c; 虚拟机使用vbox terminal 打不开 CTRL ALT F3 进入命令行模式&#xff08;需要返回桌面时CTRL ALT F1&#xff09;root用户登入cd /etc/default vi locale LANG“en_US” 改成 LANG“en_US.UTF-8”保存修改后&…
阅读更多...
YOLOV8替换Lion优化器

YOLOV8替换Lion优化器

YOLOV8替换Lion优化器 1 优化器介绍博客 参考bilibili讲解视频 论文地址&#xff1a;https://arxiv.org/abs/2302.06675 代码地址&#xff1a;https://github.com/google/automl/blob/master/lion/lion_pytorch.py """PyTorch implementation of the Lion …
阅读更多...
linux 上源码编译安装 PolarDB-X

linux 上源码编译安装 PolarDB-X

PolarDB-X 简介 PolarDB-X 是一款面向超高并发、海量存储、复杂查询场景设计的云原生分布式数据库系统。其采用 Shared-nothing 与存储计算分离架构&#xff0c;支持水平扩展、分布式事务、混合负载等能力&#xff0c;具备企业级、云原生、高可用、高度兼容 MySQL 系统及生态等…
阅读更多...
CTF-web基础 HTTP协议

CTF-web基础 HTTP协议

基础 HTTPHypertext Transfer Protocol 超文本链接协议&#xff0c;他是无状态的&#xff08;每一次请求都是独立的&#xff09;&#xff0c;发出request发给服务器然后返回responce&#xff0c;现在的版本是1.1版本&#xff0c;默认端口80&#xff08;https是443&#xff09;…
阅读更多...
ubuntu上安装HBase伪分布式-2024年08月04日

ubuntu上安装HBase伪分布式-2024年08月04日

ubuntu上安装HBase伪分布式-2024年08月04日 1.HBase介绍2.HBase与Hadoop的关系3.安装前言4.下载及安装5.单机配置6.伪分布式配置 1.HBase介绍 HBase是一个开源的非关系型数据库&#xff0c;它基于Google的Bigtable设计&#xff0c;用于支持对大型数据集的实时读写访问。HBase有…
阅读更多...
rust读取csv文件，匹配搜索字符

rust读取csv文件，匹配搜索字符

1.代码 use std::fs::File; use std::io::{BufRead, BufReader}; use regex::{Regex};fn main() {let f File::open("F:\\0-X-RUST\\1-systematic\\ch2-fileRead\\data\\test.csv").unwrap();let mut reader BufReader::new(f);let re Regex::new("45asd&qu…
阅读更多...
Stable Diffusion绘画 | 文生图-采样器使用说明

Stable Diffusion绘画 | 文生图-采样器使用说明

webui 1.9.3版本中&#xff0c;采样器分为“采样方法”、“调度类型”两个选项。 因为采样器选项多&#xff0c;所以需要做一个筛选&#xff0c;保留图像生成效果好的采样器。 老派采样器 可以选择砍掉的采样器&#xff1a; DDIMPLMS 最为推荐保留的采样器&#xff1a; Eul…
阅读更多...
Python 实现股票指标计算——LON

Python 实现股票指标计算——LON

LON - 铁龙长线 1 公式 LC : REF(CLOSE,1); VID : SUM(VOL,2)/(((HHV(HIGH,2)-LLV(LOW,2)))*100); RC : (CLOSE-LC)*VID; LONG : SUM(RC,0); DIFF : SMA(LONG,10,1); DEA : SMA(LONG,20,1); LON : DIFF-DEA; LONMA : MA(LON,10); LONT : LON, COLORSTICK; 2 数据准备…
阅读更多...
03 库的操作

03 库的操作

目录 创建查看修改删除备份和恢复查看连接情况 1. 创建 语法 CRATE DATABASE [IF NOT EXISTS] db_name [create_specification [, create_specification] …] create_specification:  CHARACTER SET charset_name  CPLLATE collation_name 说明&#xff1a; 大写的标识关键…
阅读更多...
C语言函数传参

C语言函数传参

文章目录 &#x1f34a;自我介绍&#x1f34a;函数传参之值传递&#x1f34a;函数传参之地址传递&#x1f34a;函数传参之数组 你的点赞评论就是对博主最大的鼓励 当然喜欢的小伙伴可以&#xff1a;点赞关注评论收藏&#xff08;一键四连&#xff09;哦~ &#x1f34a;自我介绍…
阅读更多...
SQL中的窗口函数

SQL中的窗口函数

1.窗口函数简介 窗口函数是SQL中的一项高级特性&#xff0c;用于在不改变查询结果集行数的情况下&#xff0c;对每一行执行聚合计算或者其他复杂的计算&#xff0c;也就是说窗口函数可以跨行计算&#xff0c;可以扫描所有的行&#xff0c;并把结果填到每一行中。这些函数通常与…
阅读更多...
推荐文章
最新文章

Copyright @ 2022~2023