|
说起万年历，各位并不陌生，也可能大家设计过或者甚至看过别人设计的万年历，当然少不了用程序语言开发设计。至于算法嘛，肯定是多种多样的，纵观我所看到的万年历设计的算法，多数的可读性不是很好，换句话说就是对于一般程序设计者而言都不大容易看懂，正如一个书法一样，并不是越潦草、大家越认不到就越有水平；同样，一个算法的可读性越好，证明其逻辑上越易理解越严密，我想，这是不难理解的，对吧？ 今天，我要从高级办公工作者的角度设计这个万年历，充分利用Excel中的单元格区域进行有效的万年历设计。我们要实现通过选择年份自动生成该年份的万年历数据，并且我们可以随时清除万年历数据。 根据我说的功能看似简单，要实现起来，还是要花些功夫和耐心的哦。比如，要将日子数据精准无误地填入Excel应有的单元格区域位置，必须进行每月的第一天进行定位的算法设计，后续的日子则可以统统加上这个位置再减一等。当然，还有更多的细节。 下面，我们就来给大家娓娓道来吧。老规矩，还是干货分享给大家咯！ 一、Excel万年历的前端界面设计 首先插入一个表单标签控件、一个表单组合框控件、一个表单按钮控件；然后再设计万年历数据的模版。具体如下图所示
图1 万年历前端界面 二、Excel万年历的后台VBA功能代码 (一)模块1中的代码： Public shp_year_select As Shape, y '定义公有全局变量年份选择组合框shp_year_select和用于存储选择的年份变量y，以便所有的过程都可以调用和回传数据 Sub Run_Fill_Calender() '运行填充日历 [b4].Select n = shp_year_select.ControlFormat.Value y = shp_year_select.ControlFormat.List(n) [q1] = y & " 年历" Fill_Calender_Datas '调用“填充日历数据”过程 [a65535] = y '将选择过的年份存储在单元格"A65535"中 End Sub Sub Fill_Calender_Datas() '填充日历数据 Dim rg(1 To 12) As Range '定义12个元素的的范围区域对象数组 '为区域对象数组的每个区域对象元素对象指派这12个区域对象具体的实体 Set rg(1) = [b5:h10]: Set rg(2) = [j5:p10]: Set rg(3) = [r5:x10]: Set rg(4) = [z5:af10] Set rg(5) = [b15:h20]: Set rg(6) = [j15:p20]: Set rg(7) = [r15:x20]: Set rg(8) = [z15:af20] Set rg(9) = [b25:h30]: Set rg(10) = [j25:p30]: Set rg(11) = [r25:x30]: Set rg(12) = [z25:af30] For i = 1 To 12 Select Case i Case 1, 3, 5, 7, 8, 10, 12: days_31 y, i, rg(i) Case 4, 6, 9, 11: days_30 y, i, rg(i) Case 2: days_29_Or_28 y, i, rg(i) End Select Next End Sub Sub Erse_Calender_Datas() '清空日历数据 Dim rg As Range Set rg = [5:10,15:20,25:30] [b4].Select rg.ClearContents [q1] = "---- 年历" yr = Year(Date) '以下是定位当今日期的年份在表单组合框中显示 For i = 1 To shp_year_select.ControlFormat.ListCount If yr = Val(shp_year_select.ControlFormat.List(i)) Then n = i Exit For End If Next shp_year_select.ControlFormat.ListIndex = n End Sub Sub days_31(y, m, r As Range) '月大--31天 Dim da As Date, d r.ClearContents week_str = "日一二三四五六" d = 1 da = CDate(y & "-" & m & "-" & d) '将字符串动态转换为真正的日期 ws = Mid(Format(da, "[$-804]aaaa"), 3) '从转换为星期XX的字符串中提取大写星期几的汉字保存在ws中 First_Day_Pos_In_Week_Area = InStr(week_str, ws) '每月初始的1号在日历星期区域的定位位置 For d = 1 To 31 da = CDate(y & "-" & m & "-" & d) '将字符串动态转换为真正的日期 ws = Mid(Format(da, "[$-804]aaaa"), 3) '从转换为星期XX的字符串中提取大写星期几的汉字保存在ws中 Other_Day_Pos_In_Week_Area = InStr(week_str, ws) '实际的每月的号数应该加上每月初始的1号在日历星期区域的定位位置减去1“”d + (First_Day_Pos_In_Week_Area - 1)，为了在第7个位置仍然将该号 _ 数放在该行，所以还得再减去1“d + (First_Day_Pos_In_Week_Area - 1) - 1”，然后再除7取整，同时乘以7后加上该号数在日历中星期区域的实际列数 _ 位置，即可得到该号数在日历区域的设计位置 p = Int((d + (First_Day_Pos_In_Week_Area - 1) - 1) / 7) * 7 + Other_Day_Pos_In_Week_Area r(p) = d '在日历正确位置p处填充实际该号数 If da = Date Then r(p).Select '若选择年份后不断瞬时生成的日期da和现在的日期匹配，则将当前填充的日期单元格选择成活动状态 Next End Sub Sub days_30(y, m, r As Range) '月小--30天 Dim da As Date, d r.ClearContents week_str = "日一二三四五六" d = 1 da = CDate(y & "-" & m & "-" & d) '将字符串动态转换为真正的日期 ws = Mid(Format(da, "[$-804]aaaa"), 3) '从转换为星期XX的字符串中提取大写星期几的汉字保存在ws中 First_Day_Pos_In_Week_Area = InStr(week_str, ws) '每月初始的1号在日历星期区域的定位位置 For d = 1 To 30 da = CDate(y & "-" & m & "-" & d) '将字符串动态转换为真正的日期 ws = Mid(Format(da, "[$-804]aaaa"), 3) '从转换为星期XX的字符串中提取大写星期几的汉字保存在ws中 Other_Day_Pos_In_Week_Area = InStr(week_str, ws) '实际的每月的号数应该加上每月初始的1号在日历星期区域的定位位置减去1“”d + (First_Day_Pos_In_Week_Area - 1)，为了在第7个位置仍然将该号 _ 数放在该行，所以还得再减去1“d + (First_Day_Pos_In_Week_Area - 1) - 1”，然后再除7取整，同时乘以7后加上该号数在日历中星期区域的实际列数 _ 位置，即可得到该号数在日历区域的设计位置 p = Int((d + (First_Day_Pos_In_Week_Area - 1) - 1) / 7) * 7 + Other_Day_Pos_In_Week_Area r(p) = d '在日历正确位置p处填充实际该号数 If da = Date Then r(p).Select '若选择年份后不断瞬时生成的日期da和现在的日期匹配，则将当前填充的日期单元格选择成活动状态 Next End Sub Sub days_29_Or_28(y, m, r As Range) '闰年2月份29天，平年2月份28天(例如2020年就是闰年) Dim da As Date, d r.ClearContents week_str = "日一二三四五六" d = 1 da = CDate(y & "-" & m & "-" & d) '将字符串动态转换为真正的日期 ws = Mid(Format(da, "[$-804]aaaa"), 3) '从转换为星期XX的字符串中提取大写星期几的汉字保存在ws中 First_Day_Pos_In_Week_Area = InStr(week_str, ws) '每月初始的1号在日历星期区域的定位位置 If Is_LeepYear(y) Then '闰年2月份天数 For d = 1 To 29 da = CDate(y & "-" & m & "-" & d) '将字符串动态转换为真正的日期 ws = Mid(Format(da, "[$-804]aaaa"), 3) '从转换为星期XX的字符串中提取大写星期几的汉字保存在ws中 Other_Day_Pos_In_Week_Area = InStr(week_str, ws) '实际的每月的号数应该加上每月初始的1号在日历星期区域的定位位置减去1“”d + (First_Day_Pos_In_Week_Area - 1)，为了在第7个位置仍然将该 _ 号数放在该行，所以还得再减去1“d + (First_Day_Pos_In_Week_Area - 1) - 1”，然后再除7取整，同时乘以7后加上该号数在日历中星期区域的实 _ 际列数位置，即可得到该号数在日历区域的设计位置 p = Int((d + (First_Day_Pos_In_Week_Area - 1) - 1) / 7) * 7 + Other_Day_Pos_In_Week_Area r(p) = d '在日历正确位置p处填充实际该号数 If da = Date Then r(p).Select '若选择年份后不断瞬时生成的日期da和现在的日期匹配，则将当前填充的日期单元格选择成活动状态 Next Else '平年2月份天数 For d = 1 To 28 da = CDate(y & "-" & m & "-" & d) '将字符串动态转换为真正的日期 ws = Mid(Format(da, "[$-804]aaaa"), 3) '从转换为星期XX的字符串中提取大写星期几的汉字保存在ws中 Other_Day_Pos_In_Week_Area = InStr(week_str, ws) '实际的每月的号数应该加上每月初始的1号在日历星期区域的定位位置减去1“”d + (First_Day_Pos_In_Week_Area - 1)，为了在第7个位置仍然将该 _ 号数放在该行，所以还得再减去1“d + (First_Day_Pos_In_Week_Area - 1) - 1”，然后再除7取整，同时乘以7后加上该号数在日历中星期区域的实 _ 际列数位置，即可得到该号数在日历区域的设计位置 p = Int((d + (First_Day_Pos_In_Week_Area - 1) - 1) / 7) * 7 + Other_Day_Pos_In_Week_Area r(p) = d '在日历正确位置p处填充实际该号数 If da = Date Then r(p).Select '若选择年份后不断瞬时生成的日期da和现在的日期匹配，则将当前填充的日期单元格选择成活动状态 Next End If End Sub Function Is_LeepYear(y) As Boolean '给定的年份是否为闰年LeepYear的判断 If (y Mod 400 = 0) Or (y Mod 100 <> 0 And y Mod 4 = 0) Then Is_LeepYear = True Else Is_LeepYear = False End If End Function (二)分别为表单组合框控件和表单按钮控件指定运行宏。如下图所示
图2 表单组合框控件和表单按钮控件指定运行宏 (三)ThisWorkbook中的代码： Private Sub Workbook_Open() '工作簿一打开即刻初始化表单组合框数据并且在组合框中显示之前选择过的年份 Set shp_year_select = Sheets(1).Shapes("年份选择") shp_year_select.ControlFormat.RemoveAllItems '万年历的年份范围初步设定为“1900～9999” For i = 1900 To 9999 shp_year_select.ControlFormat.AddItem i Next '以下是重新还原表单组合框控件之前选定过的年份显示 yr = [a65535] For i = 1 To shp_year_select.ControlFormat.ListCount If yr = Val(shp_year_select.ControlFormat.List(i)) Then n = i '遍历整个表单组合框所有元素，查找与yr是否相匹配的元素，若找到即刻记下该编号并存于n中 Exit For End If Next shp_year_select.ControlFormat.ListIndex = n '让表单组合框显示找到的之前选择过的年份 End Sub 三、万年历运行测试 (一)准备清除万年历数据：点击按钮，即将进行日历数据清除。如下图所示
图3 压下按钮 (二)清除万年历数据的结果：点击按钮后，会发现日历数据均已清除。如下图所示
图4 清除日历数据的结果 (三)准备生成新的年份的日历数据：点击组合框的年份，会发现日历数据生成呈准备状态。如下图所示
图5 准备生成日历数据 (四)生成选定年份的日历数据的结果：选择了年份后，会发现该年份的日历数据快速生成。如下图所示
图6 新年份日历数据的生成 四、万年历设计的技术小结 (一)充分利用Excel单元格区域的规整性设计万年历模版。如下图所示
图7 万年历模版 (二)后台代码设计中设计范围区域数组的形式，大大简化了定义多个范围区域的繁琐性。例如：Dim rg(1 To 12) As Range'定义12个元素的的范围区域对象数组 (三)利用给每月的日子生成过程查找xxxx年x月x日在一个星期中的列向定位，从而达到正确、准确将该日期的日子填入日历中的正确位置。如下关键代码截图所示
图8 定位每月第一天在日历中每月应有的位置 (四)利用平年闰年二月份的不同天数，巧妙设计准确的日历数据。如下代码截图所示
图9 根据平年闰年不同快速填充二月数据 好了，本期我们就分享到此处吧！真心希望给大家带来工作上的帮助哦！ |
|
|
