Office中国论坛/Access中国论坛

标题: 自定义农历函数 [打印本页]

作者: tanhong 时间: 2008-1-17 17:10
标题: 自定义农历函数
[attach]28025[/attach]
'-----------------------------------------------------------
'函数:自定义农历及天干地支函数
'输出:字符串
'实例:
'Print WDateToEDate(#2/9/2005#)
'农历乙酉年(鸡)正月初一
'------------------------------------------------------------
Function WDateToEDate(ByVal curTime As Date) As String
Dim WeekName(7), MonthAdd(11), NongliData(99), TianGan(9), DiZhi(11), ShuXiang(11), DayName(30), MonName(12)
Dim curYear, curMonth, curDay, curWeekday
Dim GongliStr, WeekdayStr, NongliStr, NongliDayStr
Dim i, m, n, k, isEnd, bit, TheDate

'星期名
WeekName(0) = " * "
WeekName(1) = "星期日"
WeekName(2) = "星期一"
WeekName(3) = "星期二"
WeekName(4) = "星期三"
WeekName(5) = "星期四"
WeekName(6) = "星期五"
WeekName(7) = "星期六"
'天干名称
TianGan(0) = "甲"
TianGan(1) = "乙"
TianGan(2) = "丙"
TianGan(3) = "丁"
TianGan(4) = "戊"
TianGan(5) = "己"
TianGan(6) = "庚"
TianGan(7) = "辛"
TianGan(8) = "壬"
TianGan(9) = "癸"
'地支名称
DiZhi(0) = "子"
DiZhi(1) = "丑"
DiZhi(2) = "寅"
DiZhi(3) = "卯"
DiZhi(4) = "辰"
DiZhi(5) = "巳"
DiZhi(6) = "午"
DiZhi(7) = "未"
DiZhi(8) = "申"
DiZhi(9) = "酉"
DiZhi(10) = "戌"
DiZhi(11) = "亥"
'属相名称
ShuXiang(0) = "鼠"
ShuXiang(1) = "牛"
ShuXiang(2) = "虎"
ShuXiang(3) = "兔"
ShuXiang(4) = "龙"
ShuXiang(5) = "蛇"
ShuXiang(6) = "马"
ShuXiang(7) = "羊"
ShuXiang(8) = "猴"
ShuXiang(9) = "鸡"
ShuXiang(10) = "狗"
ShuXiang(11) = "猪"
'农历日期名
DayName(0) = "*"
DayName(1) = "初一"
DayName(2) = "初二"
DayName(3) = "初三"
DayName(4) = "初四"
DayName(5) = "初五"
DayName(6) = "初六"
DayName(7) = "初七"
DayName(8) = "初八"
DayName(9) = "初九"
DayName(10) = "初十"
DayName(11) = "十一"
DayName(12) = "十二"
DayName(13) = "十三"
DayName(14) = "十四"
DayName(15) = "十五"
DayName(16) = "十六"
DayName(17) = "十七"
DayName(18) = "十八"
DayName(19) = "十九"
DayName(20) = "二十"
DayName(21) = "廿一"
DayName(22) = "廿二"
DayName(23) = "廿三"
DayName(24) = "廿四"
DayName(25) = "廿五"
DayName(26) = "廿六"
DayName(27) = "廿七"
DayName(28) = "廿八"
DayName(29) = "廿九"
DayName(30) = "三十"
'农历月份名
MonName(0) = "*"
MonName(1) = "正"
MonName(2) = "二"
MonName(3) = "三"
MonName(4) = "四"
MonName(5) = "五"
MonName(6) = "六"
MonName(7) = "七"
MonName(8) = "八"
MonName(9) = "九"
MonName(10) = "十"
MonName(11) = "十一"
MonName(12) = "腊"
'公历每月前面的天数
MonthAdd(0) = 0
MonthAdd(1) = 31
MonthAdd(2) = 59
MonthAdd(3) = 90
MonthAdd(4) = 120
MonthAdd(5) = 151
MonthAdd(6) = 181
MonthAdd(7) = 212
MonthAdd(8) = 243
MonthAdd(9) = 273
MonthAdd(10) = 304
MonthAdd(11) = 334
'农历数据
NongliData(0) = 2635
NongliData(1) = 333387
NongliData(2) = 1701
NongliData(3) = 1748
NongliData(4) = 267701
NongliData(5) = 694
NongliData(6) = 2391
NongliData(7) = 133423
NongliData(8) = 1175
NongliData(9) = 396438
NongliData(10) = 3402
NongliData(11) = 3749
NongliData(12) = 331177
NongliData(13) = 1453
NongliData(14) = 694
NongliData(15) = 201326
NongliData(16) = 2350
NongliData(17) = 465197
NongliData(18) = 3221
NongliData(19) = 3402
NongliData(20) = 400202
NongliData(21) = 2901
NongliData(22) = 1386
NongliData(23) = 267611
NongliData(24) = 605
NongliData(25) = 2349
NongliData(26) = 137515
NongliData(27) = 2709
NongliData(28) = 464533
NongliData(29) = 1738
NongliData(30) = 2901
NongliData(31) = 330421
NongliData(32) = 1242
NongliData(33) = 2651
NongliData(34) = 199255
NongliData(35) = 1323
NongliData(36) = 529706
NongliData(37) = 3733
NongliData(38) = 1706
NongliData(39) = 398762
NongliData(40) = 2741
NongliData(41) = 1206
NongliData(42) = 267438
NongliData(43) = 2647
NongliData(44) = 1318
NongliData(45) = 204070
NongliData(46) = 3477
NongliData(47) = 461653
NongliData(48) = 1386
NongliData(49) = 2413
NongliData(50) = 330077
NongliData(51) = 1197
NongliData(52) = 2637
NongliData(53) = 268877
NongliData(54) = 3365
NongliData(55) = 531109
NongliData(56) = 2900
NongliData(57) = 2922
NongliData(58) = 398042
NongliData(59) = 2395
NongliData(60) = 1179
NongliData(61) = 267415
NongliData(62) = 2635
NongliData(63) = 661067
NongliData(64) = 1701
NongliData(65) = 1748
NongliData(66) = 398772
NongliData(67) = 2742
NongliData(68) = 2391
NongliData(69) = 330031
NongliData(70) = 1175
NongliData(71) = 1611
NongliData(72) = 200010
NongliData(73) = 3749
NongliData(74) = 527717
NongliData(75) = 1452
NongliData(76) = 2742
NongliData(77) = 332397
NongliData(78) = 2350
NongliData(79) = 3222
NongliData(80) = 268949
NongliData(81) = 3402
NongliData(82) = 3493
NongliData(83) = 133973
NongliData(84) = 1386
NongliData(85) = 464219
NongliData(86) = 605
NongliData(87) = 2349
NongliData(88) = 334123
NongliData(89) = 2709
NongliData(90) = 2890
NongliData(91) = 267946
NongliData(92) = 2773
NongliData(93) = 592565
NongliData(94) = 1210
NongliData(95) = 2651
NongliData(96) = 395863
NongliData(97) = 1323
NongliData(98) = 2707
NongliData(99) = 265877
'生成当前公历年、月、日 ==> GongliStr
curYear = Year(curTime)
curMonth = Month(curTime)
curDay = Day(curTime)
GongliStr = curYear & "年"
If (curMonth < 10) Then
      GongliStr = GongliStr & "0" & curMonth & "月"
Else
      GongliStr = GongliStr & curMonth & "月"
End If
If (curDay < 10) Then
      GongliStr = GongliStr & "0" & curDay & "日"
Else
      GongliStr = GongliStr & curDay & "日"
End If
'生成当前公历星期 ==> WeekdayStr
curWeekday = Weekday(curTime)
WeekdayStr = WeekName(curWeekday)
'计算到初始时间1921年2月8日的天数：1921-2-8(正月初一)
TheDate = (curYear - 1921) * 365 + Int((curYear - 1921) / 4) + curDay + MonthAdd(curMonth - 1) - 38
If ((curYear Mod 4) = 0 And curMonth > 2) Then
      TheDate = TheDate + 1
End If
'计算农历天干、地支、月、日
isEnd = 0
m = 0
Do
      If (NongliData(m) < 4095) Then
         k = 11
      Else
         k = 12
      End If
      n = k
      Do
         If (n < 0) Then
            Exit Do
         End If
         '获取NongliData(m)的第n个二进制位的值
         bit = NongliData(m)
         For i = 1 To n Step 1
            bit = Int(bit / 2)
         Next
         bit = bit Mod 2
         If (TheDate <= 29 + bit) Then
            isEnd = 1
            Exit Do
         End If
         TheDate = TheDate - 29 - bit
         n = n - 1
      Loop
      If (isEnd = 1) Then
         Exit Do
      End If
      m = m + 1
Loop
curYear = 1921 + m
curMonth = k - n + 1
curDay = TheDate
If (k = 12) Then
      If (curMonth = (Int(NongliData(m) / 65536) + 1)) Then
         curMonth = 1 - curMonth
      ElseIf (curMonth > (Int(NongliData(m) / 65536) + 1)) Then
         curMonth = curMonth - 1
      End If
End If
'生成农历天干、地支、属相 ==> NongliStr
N & TianGan(((curYear - 4) Mod 60) Mod 10) & DiZhi(((curYear - 4) Mod 60) Mod 12) & "年"
NongliStr = NongliStr & "(" & ShuXiang(((curYear - 4) Mod 60) Mod 12) & ")"
'生成农历月、日 ==> NongliDayStr
If (curMonth < 1) Then
      N & MonName(-1 * curMonth)
Else
      NongliDayStr = MonName(curMonth)
End If
NongliDayStr = NongliDayStr & "月"
NongliDayStr = NongliDayStr & DayName(curDay)
WDateToEDate = NongliStr & NongliDayStr
End Function

[ 本帖最后由 tanhong 于 2008-1-30 20:20 编辑 ]

作者: tmtony 时间: 2008-1-17 17:14
这个要收藏了!!

作者: hunrybecky 时间: 2008-1-30 17:13
太长了，代码。。。。。。。。。。。

作者: wysizhh 时间: 2008-2-16 11:01
学习下

作者: sblisb 时间: 2008-11-3 11:49
学习一下

作者: njy6000 时间: 2009-1-17 20:03
农历,看看.

作者: WDLRCZT 时间: 2009-1-17 20:29
收藏了!!

作者: zpw001 时间: 2009-1-31 05:05
楼主辛苦了

作者: cclxf 时间: 2009-5-26 10:00
正需要啦！辛苦了

作者: wfx_291 时间: 2009-5-27 12:38
正需要啦！辛苦了

作者: yanwei82123300 时间: 2009-6-26 16:26
这个要收藏了!!

作者: chaojianan 时间: 2009-10-13 20:53
谢谢江版。

作者: goto2008 时间: 2009-12-9 15:48
谢谢分享

作者: liaoqiang234 时间: 2010-2-5 19:41
学习

作者: ynjxw 时间: 2010-2-26 10:55
see

作者: ycxchen 时间: 2010-5-11 16:53
谢谢分享，学习！

作者: zq198306 时间: 2010-5-12 08:59
我也来看看

作者: 快乐夏天 时间: 2010-5-12 21:09
不错,支持一下

作者: gujin162 时间: 2011-1-21 13:32
自定义农历函数

作者: YXH_YXH 时间: 2011-3-13 21:51
在求！！！！！！！！！！！

作者: yaozi 时间: 2011-8-23 13:04
正需要啦！辛苦了

作者: 游戏人生 时间: 2011-12-23 23:21
学习

作者: smilingkiss 时间: 2011-12-31 11:23
这个很强大

作者: smilingkiss 时间: 2011-12-31 11:23
先收藏后研究

作者: hgxly 时间: 2012-1-18 10:25
一定要学习

作者: wgh3g 时间: 2012-1-18 11:11
收藏了

作者: wufeng980114 时间: 2012-8-4 11:50
看看是啥？好用不？

作者: c101 时间: 2013-1-24 16:43
学习一下

作者: cpxie 时间: 2015-6-1 17:05
感谢分享

作者: 真主 时间: 2021-2-18 09:37
我之前用的那个农历这两天出问题了，看看这个有没有问题，谢谢

作者: 真主 时间: 2021-2-18 09:40
一样报错，显示If (NongliData(m) < 4095) Then下标出错，因为m=100了，请问这个怎样解决，谢谢！

作者: liumporite 时间: 2024-8-2 10:41
需要谢谢

作者: lwx0707 时间: 2024-9-26 21:09
学习中，楼主辛苦啦

欢迎光临 Office中国论坛/Access中国论坛 (http://www.office-cn.net/)