惯性聚合 高效追踪和阅读你感兴趣的博客、新闻、科技资讯
阅读原文 在惯性聚合中打开

推荐订阅源

Last Week in AI
Last Week in AI
阮一峰的网络日志
阮一峰的网络日志
P
Proofpoint News Feed
让小产品的独立变现更简单 - ezindie.com
让小产品的独立变现更简单 - ezindie.com
MongoDB | Blog
MongoDB | Blog
云风的 BLOG
云风的 BLOG
OSCHINA 社区最新新闻
OSCHINA 社区最新新闻
J
Java Code Geeks
WordPress大学
WordPress大学
T
The Blog of Author Tim Ferriss
V
Visual Studio Blog
小众软件
小众软件
Microsoft Azure Blog
Microsoft Azure Blog
博客园_首页
IT之家
IT之家
Vercel News
Vercel News
C
Check Point Blog
Google DeepMind News
Google DeepMind News
月光博客
月光博客
D
DataBreaches.Net
酷 壳 – CoolShell
酷 壳 – CoolShell
美团技术团队
Y
Y Combinator Blog
Hugging Face - Blog
Hugging Face - Blog

博客园 - 云起

ArcGISPro SDK Addin打包机制 一次 ArcGISPro Addin项本地化的排查实录 记一次arm机器装系统的经历 记一次vs中无法找到win sdk的问题 arcpy运行时,报错产品许可尚未初始化 Visual Studio 2022生成解决方案代码图报错“无法连接到指定的数据库” win10下定制文件夹 excel中,根据文件名查询文件路径 ArcGISPro SDK 3.1版本中使用QueuedTask的小问题 Compress-Archive压缩zip包的小瑕疵 Pro更新字段别名,重载数据后失效 在多个office文档内替换关键字 git日志分组 xlst处理时命名空间带来的小坑 更新压缩流 微软中文输入法带来的一点小坑,导致arcgispro输入中文异常 使用C#获取文件详情 Pro更改启动界面 使用AES加密时,结果不一样 命令行程序读取注册表失败的分析 pg_index
使用excel生成简单的日历
云起 · 2025-01-16 · via 博客园 - 云起

思路比较简单,样式也单一,丑了点。
采用宏和时间函数,计算单元格偏移量,进行单元格填充。

Sub GenerateYearCalendar()
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Sheets("Sheet1") ' 更改为你使用的表名
    
    Dim year As Integer
    year = InputBox("请输入年份 (如2025):")
    
    If Not IsNumeric(year) Or year < 1900 Or year > 2100 Then
        MsgBox "无效的年份", vbExclamation
        Exit Sub
    End If
    
    ' 清除现有内容
    ws.Cells.Clear
    
    ' 设置列宽和行高
    ws.Columns.ColumnWidth = 10
    ws.Rows.RowHeight = 20
        
    ' 初始化起始位置
    Dim startRow As Integer, startCol As Integer
    startRow = 0
    startCol = 1
    
    ' 循环生成每个月的日历
    Dim month As Integer
    For month = 1 To 12
        Call GenerateMonthCalendar(ws, year, month, startRow, startCol)
        
        ' 更新下一个月的日历起始位置
        startCol = 1
    Next month
End Sub

Sub GenerateMonthCalendar(ws As Worksheet, year As Integer, month As Integer, ByRef startRow As Integer, ByRef startCol As Integer)
    ' 设置月份标题
    startRow = startRow + 1
    ws.Cells(startRow, 1).Value = year & "年" & month & "月"
    ws.Range(ws.Cells(startRow, startCol), ws.Cells(startRow, startCol + 6)).MergeCells = True
    ws.Range(ws.Cells(startRow, startCol), ws.Cells(startRow, startCol + 6)).HorizontalAlignment = xlCenter
    ws.Range(ws.Cells(startRow, startCol), ws.Cells(startRow, startCol + 6)).VerticalAlignment = xlCenter
    startRow = startRow + 1
    
    ' 设置星期几的标题
    ws.Cells(startRow, 1).Value = "一"
    ws.Cells(startRow, 2).Value = "二"
    ws.Cells(startRow, 3).Value = "三"
    ws.Cells(startRow, 4).Value = "四"
    ws.Cells(startRow, 5).Value = "五"
    ws.Cells(startRow, 6).Value = "六"
    ws.Cells(startRow, 7).Value = "日"
    startRow = startRow + 1
    
    ' 计算第一个日期的位置
    Dim firstDay As Date
    firstDay = DateSerial(year, month, 1)
    Dim startColDate As Integer
    startColDate = Weekday(firstDay, vbMonday) - 1
    
    ' 设置日期
    Dim lastDay As Date
    lastDay = DateSerial(year, month + 1, 0)
    
    Dim row As Integer, col As Integer
    row = startRow
    col = startCol + startColDate
    
    For i = 1 To Day(lastDay)
        ws.Cells(row, col).Value = i
        col = col + 1
        ' 进行换行
        If col > 7 Then
            col = 1
            row = row + 1
        End If
    Next i
    
    ' 更新起始行
    startRow = row
End Sub