|
榮譽會員
|
本範例提供1994~2010年之間的農曆年轉換函數,採用陣列方式處理可以隨實際狀況改變農曆年的顯示方式
主 題 農曆年函數
版 本 >= 10.0(Office 2002)
說 明 本範例提供1994~2010年之間的農曆年轉換函數,採用陣列方式處理可以隨實際狀況改變農曆年的顯示方式
參 考
Dim IntToSimDay__$(31, 4)
Public rgstrMonthName(11) As String
Public rgstrDayName(6) As String
Public rgiDaysInMonth(11) As String
Dim B__1__$(11)
Dim B__2__(220)
Dim B__3__(410)
Dim B__4__$(30)
Dim B__5__$(12)
Dim B__6__$(12)
Dim B__7__$(23)
Dim iYear
Dim iMonth
Dim iDay
'IntToSimDay__$(, 0)'天干地支年
'IntToSimDay__$(, 1)'十二生肖年
'IntToSimDay__$(, 2)'農曆月
'IntToSimDay__$(, 3)'農曆日
'IntToSimDay__$(, 4)'24節氣
--------------------------------------------------------------------------------
Function ChineCalender(iDate)
Dim iYear As Integer, iMonth As Integer, iDay As Integer
If IsDate(iDate) Then
iYear = Year(iDate)
iMonth = Month(iDate)
iDay = Day(iDate)
Call IniLunarStr
GetLunarDays iYear, iMonth
Intyear = "民國" & Application.WorksheetFunction.Text(iYear - 1911, "[DBNum1];@") & "年"
ChineCalender = IntToSimDay__$(iDay - 1, 0) & IntToSimDay__$(iDay - 1, 1) & IntToSimDay__$(iDay - 1, 2) _
& IntToSimDay__$(iDay - 1, 3) & IntToSimDay__$(iDay, 4)
Else
ChineCalender = ""
End If
End Function
--------------------------------------------------------------------------------
Private Sub IniLunarStr()
Dim i
rgstrMonthName(0) = "一月"
rgstrMonthName(1) = "二月"
rgstrMonthName(2) = "三月"
rgstrMonthName(3) = "四月"
rgstrMonthName(4) = "五月"
rgstrMonthName(5) = "六月"
rgstrMonthName(6) = "七月"
rgstrMonthName(7) = "八月"
rgstrMonthName(8) = "九月"
rgstrMonthName(9) = "十月"
rgstrMonthName(10) = "十一月"
rgstrMonthName(11) = "十二月"
B__2__(0) = 30 '11
B__2__(1) = 29 '12 1994 (農曆月份最後一天)
B__2__(2) = 30 '1
B__2__(3) = 30 '2
B__2__(4) = 30 '3
B__2__(5) = 29 '4
B__2__(6) = 30 '5
B__2__(7) = 29 '6
B__2__(8) = 30 '7
B__2__(9) = 29 '8
B__2__(10) = 29 '9
B__2__(11) = 30 '10
B__2__(12) = 29 '11
B__2__(13) = 30 '12 1995
B__2__(14) = 29 '1
B__2__(15) = 30 '2
B__2__(16) = 30 '3
B__2__(17) = 29 '4
B__2__(18) = 30 '5
B__2__(19) = 29 '6
B__2__(20) = 30 '7
B__2__(21) = 30 '8
B__2__(22) = 39 'r8
B__2__(23) = 29 '9
B__2__(24) = 30 '10
B__2__(25) = 29 '11
B__2__(26) = 30 '12 1996
B__2__(27) = 29 '1
B__2__(28) = 30 '2
B__2__(29) = 29 '3
B__2__(30) = 30 '4
B__2__(31) = 30 '5
B__2__(32) = 29 '6
B__2__(33) = 30 '7
B__2__(34) = 29 '8
B__2__(35) = 30 '9
B__2__(36) = 30 '10
B__2__(37) = 29 '11
B__2__(38) = 29 '12 1997
B__2__(39) = 30 '1
B__2__(40) = 29 '2
B__2__(41) = 30 '3
B__2__(42) = 29 '4
B__2__(43) = 30 '5
B__2__(44) = 29 '6
B__2__(45) = 30 '7
B__2__(46) = 30 '8
B__2__(47) = 29 '9
B__2__(48) = 30 '10
B__2__(49) = 30 '11
B__2__(50) = 29 '12 1998
B__2__(51) = 30 '1
B__2__(52) = 29 '2
B__2__(53) = 29 '3
B__2__(54) = 30 '4
B__2__(55) = 29 '5
B__2__(56) = 39 'r5
B__2__(57) = 30 '6
B__2__(58) = 30 '7
B__2__(59) = 29 '8
B__2__(60) = 30 '9
B__2__(61) = 30 '10
B__2__(62) = 29 '11
B__2__(63) = 30 '12 1999
B__2__(64) = 30 '1
B__2__(65) = 29 '2
B__2__(66) = 29 '3
B__2__(67) = 30 '4
B__2__(68) = 29 '5
B__2__(69) = 29 '6
B__2__(70) = 30 '7
B__2__(71) = 29 '8
B__2__(72) = 30 '9
B__2__(73) = 30 '10
B__2__(74) = 30 '11
B__2__(75) = 29 '12 2000
B__2__(76) = 30 '1
B__2__(77) = 30 '2
B__2__(78) = 29 '3
B__2__(79) = 29 '4
B__2__(80) = 30 '5
B__2__(81) = 29 '6
B__2__(82) = 29 '7
B__2__(83) = 30 '8
B__2__(84) = 29 '9
B__2__(85) = 30 '10
B__2__(86) = 30 '11
B__2__(87) = 29 '12 2001
B__2__(88) = 30 '1
B__2__(89) = 30 '2
B__2__(90) = 29 '3
B__2__(91) = 30 '4
B__2__(92) = 39 'r4
B__2__(93) = 30 '5
B__2__(94) = 29 '6
B__2__(95) = 29 '7
B__2__(96) = 30 '8
B__2__(97) = 29 '9
B__2__(98) = 30 '10
B__2__(99) = 29 '11
B__2__(100) = 30 '12 2002
B__2__(101) = 30 '1
B__2__(102) = 30 '2
B__2__(103) = 29 '3
B__2__(104) = 30 '4
B__2__(105) = 29 '5
B__2__(106) = 30 '6
B__2__(107) = 29 '7
B__2__(108) = 29 '8
B__2__(109) = 30 '9
B__2__(110) = 29 '10
B__2__(111) = 30 '11
B__2__(112) = 29 '12 2003
B__2__(113) = 30 '1
B__2__(114) = 30 '2
B__2__(115) = 29 '3
B__2__(116) = 30 '4
B__2__(117) = 30 '5
B__2__(118) = 29 '6
B__2__(119) = 30 '7
B__2__(120) = 29 '8
B__2__(121) = 29 '9
B__2__(122) = 30 '10
B__2__(123) = 29 '11
B__2__(124) = 30 '12 2004
B__2__(125) = 29 '1
B__2__(126) = 30 '2
B__2__(127) = 39 'r2
B__2__(128) = 30 '3
B__2__(129) = 30 '4
B__2__(130) = 29 '5
B__2__(131) = 30 '6
B__2__(132) = 29 '7
B__2__(133) = 30 '8
B__2__(134) = 29 '9
B__2__(135) = 30 '10
B__2__(136) = 29 '11
B__2__(137) = 30 '12 2005
B__2__(138) = 29 '1 2005
B__2__(139) = 30 '2 2005
B__2__(140) = 29 '3 2005
B__2__(141) = 30 '4 2005
B__2__(142) = 29 '5 2005
B__2__(143) = 30 '6 2005
B__2__(144) = 30 '7 2005
B__2__(145) = 29 '8 2005
B__2__(146) = 30 '9 2005
B__2__(147) = 29 '10 2005
B__2__(148) = 30 '11 2005
B__2__(149) = 29 '12 2006
B__2__(150) = 30 '1 2006
B__2__(151) = 29 '2 2006
B__2__(152) = 30 '3 2006
B__2__(153) = 29 '4 2006
B__2__(154) = 30 '5 2006
B__2__(155) = 29 '6 2006
B__2__(156) = 30 '7 2006
B__2__(157) = 39 '7 2006 r2
B__2__(158) = 30 '8 2006
B__2__(159) = 30 '9 2006
B__2__(160) = 29 '10 2006
B__2__(161) = 30 '11 2006
B__2__(162) = 30 '12 2006
B__2__(163) = 29 '1 2007
B__2__(164) = 29 '2 2007
B__2__(165) = 30 '3 2007
B__2__(166) = 29 '4 2007
B__2__(167) = 29 '5 2007
B__2__(168) = 30 '6 2007
B__2__(169) = 29 '7 2007
B__2__(170) = 30 '8 2007
B__2__(171) = 30 '9 2007
B__2__(172) = 30 '10 2007
B__2__(173) = 29 '11 2007
B__2__(174) = 30 '12 2007
B__2__(175) = 30 '1 2008
B__2__(176) = 29 '2 2008
B__2__(177) = 29 '3 2008
B__2__(178) = 30 '4 2008
B__2__(179) = 29 '5 2008
B__2__(180) = 29 '6 2008
B__2__(181) = 30 '7 2008
B__2__(182) = 29 '8 2008
B__2__(183) = 30 '9 2008
B__2__(184) = 30 '10 2008
B__2__(185) = 29 '11 2008
B__2__(186) = 30 '12 2008
B__2__(187) = 30 '1 2009
B__2__(188) = 30 '2 2009
B__2__(189) = 29 '3 2009
B__2__(190) = 29 '4 2009
B__2__(191) = 30 '5 2009
B__2__(192) = 39 'r5 2009
B__2__(193) = 29 '6 2009
B__2__(194) = 30 '7 2009
B__2__(195) = 29 '8 2009
B__2__(196) = 30 '9 2009
B__2__(197) = 29 '10 2009
B__2__(198) = 30 '11 2009
B__2__(199) = 30 '12 2009
B__2__(200) = 30 '1 2010
B__2__(201) = 29 '2 2010
B__2__(202) = 30 '3 2010
B__2__(203) = 29 '4 2010
B__2__(204) = 30 '5 2010
B__2__(205) = 29 '6 2010
B__2__(206) = 29 '7 2010
B__2__(207) = 30 '8 2010
B__2__(208) = 29 '9 2010
B__2__(209) = 29 '10 2010
B__2__(210) = 30 '11 2010
B__2__(211) = 30 '12 2010
B__3__(0) = 5 '1994
B__3__(1) = 20
B__3__(2) = 4
B__3__(3) = 19
B__3__(4) = 6
B__3__(5) = 21
B__3__(6) = 5
B__3__(7) = 20
B__3__(8) = 6
B__3__(9) = 21
B__3__(10) = 6
B__3__(11) = 21
B__3__(12) = 7
B__3__(13) = 23
B__3__(14) = 8
B__3__(15) = 23
B__3__(16) = 8
B__3__(17) = 23
B__3__(18) = 8
B__3__(19) = 23
B__3__(20) = 7
B__3__(21) = 22
B__3__(22) = 7
B__3__(23) = 22
B__3__(24) = 6 '1995
B__3__(25) = 20
B__3__(26) = 4
B__3__(27) = 19
B__3__(28) = 6
B__3__(29) = 21
B__3__(30) = 5
B__3__(31) = 20
B__3__(32) = 6
B__3__(33) = 21
B__3__(34) = 6
B__3__(35) = 22
B__3__(36) = 7
B__3__(37) = 23
B__3__(38) = 8
B__3__(39) = 23
B__3__(40) = 8
B__3__(41) = 23
B__3__(42) = 9
B__3__(43) = 24
B__3__(44) = 8
B__3__(45) = 23
B__3__(46) = 7
B__3__(47) = 22
B__3__(48) = 6 '1996
B__3__(49) = 20
B__3__(50) = 4
B__3__(51) = 19
B__3__(52) = 6
B__3__(53) = 21
B__3__(54) = 5
B__3__(55) = 20
B__3__(56) = 6
B__3__(57) = 21
B__3__(58) = 6
B__3__(59) = 22
B__3__(60) = 7
B__3__(61) = 22
B__3__(62) = 7
B__3__(63) = 23
B__3__(64) = 7
B__3__(65) = 23
B__3__(66) = 8
B__3__(67) = 23
B__3__(68) = 7
B__3__(69) = 22
B__3__(70) = 7
B__3__(71) = 21
B__3__(72) = 5 '1997
B__3__(73) = 20
B__3__(74) = 4
B__3__(75) = 18
B__3__(76) = 5
B__3__(77) = 20
B__3__(78) = 5
B__3__(79) = 20
B__3__(80) = 5
B__3__(81) = 21
B__3__(82) = 5
B__3__(83) = 21
B__3__(84) = 7
B__3__(85) = 23
B__3__(86) = 7
B__3__(87) = 23
B__3__(88) = 7
B__3__(89) = 23
B__3__(90) = 8
B__3__(91) = 23
B__3__(92) = 7
B__3__(93) = 22
B__3__(94) = 7
B__3__(95) = 22
B__3__(96) = 5 '1998
B__3__(97) = 20
B__3__(98) = 4
B__3__(99) = 19
B__3__(100) = 6
B__3__(101) = 21
B__3__(102) = 5
B__3__(103) = 20
B__3__(104) = 6
B__3__(105) = 21
B__3__(106) = 6
B__3__(107) = 21
B__3__(108) = 7
B__3__(109) = 23
B__3__(110) = 8
B__3__(111) = 23
B__3__(112) = 8
B__3__(113) = 23
B__3__(114) = 8
B__3__(115) = 23
B__3__(116) = 7
B__3__(117) = 22
B__3__(118) = 7
B__3__(119) = 22
B__3__(120) = 6 '1999
B__3__(121) = 20
B__3__(122) = 4
B__3__(123) = 19
B__3__(124) = 6
B__3__(125) = 21
B__3__(126) = 5
B__3__(127) = 20
B__3__(128) = 6
B__3__(129) = 21
B__3__(130) = 6
B__3__(131) = 22
B__3__(132) = 7
B__3__(133) = 23
B__3__(134) = 8
B__3__(135) = 23
B__3__(136) = 8
B__3__(137) = 23
B__3__(138) = 9
B__3__(139) = 24
B__3__(140) = 8
B__3__(141) = 23
B__3__(142) = 7
B__3__(143) = 22
B__3__(144) = 6 '2000
B__3__(145) = 21
B__3__(146) = 4
B__3__(147) = 19
B__3__(148) = 5
B__3__(149) = 20
B__3__(150) = 4
B__3__(151) = 20
B__3__(152) = 5
B__3__(153) = 21
B__3__(154) = 5
B__3__(155) = 21
B__3__(156) = 7
B__3__(157) = 22
B__3__(158) = 7
B__3__(159) = 23
B__3__(160) = 7
B__3__(161) = 23
B__3__(162) = 8
B__3__(163) = 23
B__3__(164) = 7
B__3__(165) = 22
B__3__(166) = 7
B__3__(167) = 21
B__3__(168) = 6 '2001
B__3__(169) = 20
B__3__(170) = 4
B__3__(171) = 18
B__3__(172) = 5
B__3__(173) = 20
B__3__(174) = 5
B__3__(175) = 20
B__3__(176) = 5
B__3__(177) = 21
B__3__(178) = 5
B__3__(179) = 21
B__3__(180) = 7
B__3__(181) = 23
B__3__(182) = 7
B__3__(183) = 23
B__3__(184) = 7
B__3__(185) = 23
B__3__(186) = 8
B__3__(187) = 23
B__3__(188) = 7
B__3__(189) = 22
B__3__(190) = 7
B__3__(191) = 22
B__3__(192) = 5 '2002
B__3__(193) = 20
B__3__(194) = 4
B__3__(195) = 19
B__3__(196) = 6
B__3__(197) = 21
B__3__(198) = 5
B__3__(199) = 20
B__3__(200) = 6
B__3__(201) = 21
B__3__(202) = 6
B__3__(203) = 21
B__3__(204) = 7
B__3__(205) = 23
B__3__(206) = 8
B__3__(207) = 23
B__3__(208) = 8
B__3__(209) = 23
B__3__(210) = 8
B__3__(211) = 23
B__3__(212) = 7
B__3__(213) = 22
B__3__(214) = 7
B__3__(215) = 22
B__3__(216) = 6 '2003
B__3__(217) = 20
B__3__(218) = 4
B__3__(219) = 19
B__3__(220) = 6
B__3__(221) = 21
B__3__(222) = 5
B__3__(223) = 20
B__3__(224) = 6
B__3__(225) = 21
B__3__(226) = 6
B__3__(227) = 22
B__3__(228) = 7
B__3__(229) = 23
B__3__(230) = 8
B__3__(231) = 23
B__3__(232) = 8
B__3__(233) = 23
B__3__(234) = 9
B__3__(235) = 24
B__3__(236) = 8
B__3__(237) = 23
B__3__(238) = 7
B__3__(239) = 22
B__3__(240) = 6 '2004
B__3__(241) = 21
B__3__(242) = 4
B__3__(243) = 19
B__3__(244) = 5
B__3__(245) = 20
B__3__(246) = 4
B__3__(247) = 20
B__3__(248) = 6
B__3__(249) = 21
B__3__(250) = 5
B__3__(251) = 21
B__3__(252) = 7
B__3__(253) = 22
B__3__(254) = 7
B__3__(255) = 23
B__3__(256) = 7
B__3__(257) = 23
B__3__(258) = 8
B__3__(259) = 23
B__3__(260) = 7
B__3__(261) = 22
B__3__(262) = 7
B__3__(263) = 21
B__3__(264) = 5 '2005 1
B__3__(265) = 20 '2005 2
B__3__(266) = 4 '2005 3
B__3__(267) = 18 '2005 4
B__3__(268) = 5 '2005 5
B__3__(269) = 20 '2005 6
B__3__(270) = 5 '2005 7
B__3__(271) = 20 '2005 8
B__3__(272) = 5 '2005 9
B__3__(273) = 21 '2005 10
B__3__(274) = 5 '2005 11
B__3__(275) = 21 '2005 12
B__3__(276) = 7 '2005 13
B__3__(277) = 23 '2005 14
B__3__(278) = 7 '2005 15
B__3__(279) = 23 '2005 16
B__3__(280) = 7 '2005 17
B__3__(281) = 23 '2005 18
B__3__(282) = 8 '2005 19
B__3__(283) = 23 '2005 20
B__3__(284) = 7 '2005 21
B__3__(285) = 22 '2005 22
B__3__(286) = 7 '2005 23
B__3__(287) = 22 '2005 24
B__3__(288) = 5 '2006 1
B__3__(289) = 20 '2006 2
B__3__(290) = 4 '2006 3
B__3__(291) = 19 '2006 4
B__3__(292) = 6 '2006 5
B__3__(293) = 21 '2006 6
B__3__(294) = 5 '2006 7
B__3__(295) = 20 '2006 8
B__3__(296) = 5 '2006 9
B__3__(297) = 21 '2006 10
B__3__(298) = 6 '2006 11
B__3__(299) = 21 '2006 12
B__3__(300) = 7 '2006 13
B__3__(301) = 23 '2006 14
B__3__(302) = 7 '2006 15
B__3__(303) = 23 '2006 16
B__3__(304) = 8 '2006 17
B__3__(305) = 23 '2006 18
B__3__(306) = 8 '2006 19
B__3__(307) = 23 '2006 20
B__3__(308) = 7 '2006 21
B__3__(309) = 22 '2006 22
B__3__(310) = 7 '2006 23
B__3__(311) = 22 '2006 24
B__3__(312) = 6 '2007 1
B__3__(313) = 20 '2007 2
B__3__(314) = 4 '2007 3
B__3__(315) = 19 '2007 4
B__3__(316) = 6 '2007 5
B__3__(317) = 21 '2007 6
B__3__(318) = 5 '2007 7
B__3__(319) = 20 '2007 8
B__3__(320) = 6 '2007 9
B__3__(321) = 21 '2007 10
B__3__(322) = 6 '2007 11
B__3__(323) = 22 '2007 12
B__3__(324) = 7 '2007 13
B__3__(325) = 23 '2007 14
B__3__(326) = 8 '2007 15
B__3__(327) = 23 '2007 16
B__3__(328) = 8 '2007 17
B__3__(329) = 23 '2007 18
B__3__(330) = 8 '2007 19
B__3__(331) = 23 '2007 20
B__3__(332) = 8 '2007 21
B__3__(333) = 23 '2007 22
B__3__(334) = 7 '2007 23
B__3__(335) = 22 '2007 24
B__3__(336) = 6 '2008 1
B__3__(337) = 21 '2008 2
B__3__(338) = 4 '2008 3
B__3__(339) = 19 '2008 4
B__3__(340) = 5 '2008 5
B__3__(341) = 20 '2008 6
B__3__(342) = 4 '2008 7
B__3__(343) = 20 '2008 8
B__3__(344) = 5 '2008 9
B__3__(345) = 21 '2008 10
B__3__(346) = 5 '2008 11
B__3__(347) = 21 '2008 12
B__3__(348) = 7 '2008 13
B__3__(349) = 22 '2008 14
B__3__(350) = 7 '2008 15
B__3__(351) = 23 '2008 16
B__3__(352) = 7 '2008 17
B__3__(353) = 22 '2008 18
B__3__(354) = 8 '2008 19
B__3__(355) = 23 '2008 20
B__3__(356) = 7 '2008 21
B__3__(357) = 22 '2008 22
B__3__(358) = 7 '2008 23
B__3__(359) = 21 '2008 24
B__3__(360) = 5 '2009 1
B__3__(361) = 20 '2009 2
B__3__(362) = 4 '2009 3
B__3__(363) = 18 '2009 4
B__3__(364) = 5 '2009 5
B__3__(365) = 20 '2009 6
B__3__(366) = 4 '2009 7
B__3__(367) = 20 '2009 8
B__3__(368) = 5 '2009 9
B__3__(369) = 21 '2009 10
B__3__(370) = 5 '2009 11
B__3__(371) = 21 '2009 12
B__3__(372) = 7 '2009 13
B__3__(373) = 23 '2009 14
B__3__(374) = 7 '2009 15
B__3__(375) = 23 '2009 16
B__3__(376) = 7 '2009 17
B__3__(377) = 23 '2009 18
B__3__(378) = 8 '2009 19
B__3__(379) = 23 '2009 20
B__3__(380) = 7 '2009 21
B__3__(381) = 22 '2009 22
B__3__(382) = 7 '2009 23
B__3__(383) = 22 '2009 24
B__3__(384) = 5 '2010 1
B__3__(385) = 20 '2010 2
B__3__(386) = 4 '2010 3
B__3__(387) = 18 '2010 4
B__3__(388) = 5 '2010 5
B__3__(389) = 20 '2010 6
B__3__(390) = 4 '2010 7
B__3__(391) = 20 '2010 8
B__3__(392) = 5 '2010 9
B__3__(393) = 21 '2010 10
B__3__(394) = 5 '2010 11
B__3__(395) = 21 '2010 12
B__3__(396) = 7 '2010 13
B__3__(397) = 23 '2010 14
B__3__(398) = 7 '2010 15
B__3__(399) = 23 '2010 16
B__3__(400) = 7 '2010 17
B__3__(401) = 23 '2010 18
B__3__(402) = 8 '2010 19
B__3__(403) = 23 '2010 20
B__3__(404) = 7 '2010 21
B__3__(405) = 22 '2010 22
B__3__(406) = 7 '2010 23
B__3__(407) = 22 '2010 24
' t-birdlo:19950401 - Add for Kumi Speed Up Module
B__4__$(1) = "初一"
B__4__$(2) = "初二"
B__4__$(3) = "初三"
B__4__$(4) = "初四"
B__4__$(5) = "初五"
B__4__$(6) = "初六"
B__4__$(7) = "初七"
B__4__$(8) = "初八"
B__4__$(9) = "初九"
B__4__$(10) = "初十"
B__4__$(11) = "十一"
B__4__$(12) = "十二"
B__4__$(13) = "十三"
B__4__$(14) = "十四"
B__4__$(15) = "十五"
B__4__$(16) = "十六"
B__4__$(17) = "十七"
B__4__$(18) = "十八"
B__4__$(19) = "十九"
B__4__$(20) = "二十"
B__4__$(21) = "卄一"
B__4__$(22) = "卄二"
B__4__$(23) = "卄三"
B__4__$(24) = "卄四"
B__4__$(25) = "卄五"
B__4__$(26) = "卄六"
B__4__$(27) = "卄七"
B__4__$(28) = "卄八"
B__4__$(29) = "卄九"
B__4__$(30) = "三十"
B__5__$(1) = "閏一月"
B__5__$(2) = "閏二月"
B__5__$(3) = "閏三月"
B__5__$(4) = "閏四月"
B__5__$(5) = "閏五月"
B__5__$(6) = "閏六月"
B__5__$(7) = "閏七月"
B__5__$(8) = "閏八月"
B__5__$(9) = "閏九月"
B__5__$(10) = "閏十月"
B__5__$(11) = "閏十一"
B__5__$(12) = "閏十二"
B__6__$(1) = "正月"
For i = 2 To 12: B__6__$(i) = rgstrMonthName(i - 1): Next i
B__7__$(0) = "小寒"
B__7__$(1) = "大寒"
B__7__$(2) = "立春"
B__7__$(3) = "雨水"
B__7__$(4) = "驚蟄"
B__7__$(5) = "春分"
B__7__$(6) = "清明"
B__7__$(7) = "穀雨"
B__7__$(8) = "立夏"
B__7__$(9) = "小滿"
B__7__$(10) = "芒種"
B__7__$(11) = "夏至"
B__7__$(12) = "小暑"
B__7__$(13) = "大暑"
B__7__$(14) = "立秋"
B__7__$(15) = "處暑"
B__7__$(16) = "白露"
B__7__$(17) = "秋分"
B__7__$(18) = "寒露"
B__7__$(19) = "霜降"
B__7__$(20) = "立冬"
B__7__$(21) = "小雪"
B__7__$(22) = "大雪"
B__7__$(23) = "冬至"
End Sub
--------------------------------------------------------------------------------
Private Sub GetLunarDays(iYear, iMonth)
Dim StartOf1994Month
Dim StartOf1994Day
Dim iDS1994
Dim iDSAsk
Dim iFrom1994
Dim iTotalSim
Dim iSMName
Dim iSimMonth
Dim fDBMonth
Dim k
Dim iStartSim
Dim i
StartOf1994Month = 11
StartOf1994Day = 20
iDS1994 = DateSerial(1994, 1, 1)
iDSAsk = DateSerial(iYear, iMonth, 1)
iFrom1994 = iDSAsk - iDS1994
iTotalSim = 0
iSMName = StartOf1994Month
While iTotalSim < (iFrom1994 - StartOf1994Day)
If B__2__(iSimMonth) > 30 Then
fDBMonth = 1
iTotalSim = iTotalSim + B__2__(iSimMonth) - 10 'B_2_(0)=30
Else
fDBMonth = 0
iTotalSim = iTotalSim + B__2__(iSimMonth)
iSMName = iSMName + 1
If iSMName > 12 Then iSMName = 1
End If
iSimMonth = iSimMonth + 1
Wend
If B__2__(iSimMonth) > 30 Then
k = B__2__(iSimMonth) - 10
iSMName = iSMName - 1
Else
k = B__2__(iSimMonth)
End If
iStartSim = StartOf1994Day + (iFrom1994 - iTotalSim)
If iStartSim > k Then
iStartSim = iStartSim Mod k
iSimMonth = iSimMonth + 1
If B__2__(iSimMonth) > 30 Then
fDBMonth = 1
k = B__2__(iSimMonth) - 10
Else
fDBMonth = 0
k = B__2__(iSimMonth)
If B__2__(iSimMonth) < 31 Then iSMName = iSMName + 1
If iSMName > 12 Then iSMName = 1
End If
End If
lunYeay = iYear
For i = 0 To 30
If iStartSim = 1 Then
If fDBMonth = 1 Then
IntToSimDay__$(i, 2) = B__5__$(iSMName)
IntToSimDay__$(i, 3) = B__4__$(iStartSim)
IntToSimDay__$(i, 4) = GetLunarSections(i, iYear, iMonth)
IntToSimDay__$(i, 0) = lunCalYear(i, iYear, iMonth)
IntToSimDay__$(i, 1) = TwelveAnimals(i, iYear, iMonth)
Else
IntToSimDay__$(i, 2) = B__6__$(iSMName)
IntToSimDay__$(i, 3) = B__4__$(iStartSim)
IntToSimDay__$(i, 4) = GetLunarSections(i, iYear, iMonth)
IntToSimDay__$(i, 0) = lunCalYear(i, iYear, iMonth)
IntToSimDay__$(i, 1) = TwelveAnimals(i, iYear, iMonth)
End If
iStartSim = iStartSim + 1
Else
If iStartSim > k Then
iSimMonth = iSimMonth + 1
iStartSim = 1
i = i - 1
If B__2__(iSimMonth) > 30 Then
k = B__2__(iSimMonth) - 10
fDBMonth = 1
Else
k = B__2__(iSimMonth)
fDBMonth = 0
iSMName = iSMName + 1
If iSMName > 12 Then iSMName = 1
End If
If iSMName = 1 Then
lunYeay = iYear + 1
Else
lunYeay = iYear
End If
Else
IntToSimDay__$(i, 2) = B__6__$(iSMName)
IntToSimDay__$(i, 3) = B__4__$(iStartSim)
IntToSimDay__$(i, 4) = GetLunarSections(i, iYear, iMonth)
IntToSimDay__$(i, 0) = lunCalYear(i, iYear, iMonth)
IntToSimDay__$(i, 1) = TwelveAnimals(i, iYear, iMonth)
iStartSim = iStartSim + 1
End If
End If
Next
' GetLunarSections iYear, iMonth
End Sub
--------------------------------------------------------------------------------
Function GetLunarSections(i, iYear, iMonth)
Dim iSimSection
Dim j
iSimSection = (iYear - 1994) * 24 + (iMonth - 1) * 2
j = B__3__(iSimSection)
If i = j Then
GetLunarSections = B__7__$((iMonth - 1) * 2)
Exit Function
Else
GetLunarSections = ""
End If
j = B__3__(iSimSection + 1)
If j = i Then
GetLunarSections = B__7__$((iMonth - 1) * 2 + 1)
Exit Function
Else
GetLunarSections = ""
End If
End Function
--------------------------------------------------------------------------------
Function lunCalYear(i, iYear, iMonth) 'lunarCalendarYear(天干地支年)
Dim Gan()
Dim Zhi()
Gan = Array("甲", "乙", "丙", "丁", "戊", "己", "庚", "辛", "壬", "癸")
Zhi = Array("子", "丑", "寅", "卯", "辰", "巳", "午", "未", "申", "酉", "戌", "亥")
Y = iYear
If iMonth = 1 Or iMonth = 2 Then
If IntToSimDay__$(i, 2) = "十一月" Or IntToSimDay__$(i, 2) = "十二月" Then
Y = Y - 1
End If
End If
While (Y - 1904) >= 10 '天干
Y = Y - 10
Wend
rGan = Gan(Y - 1904)
Y = iYear
If iMonth = 1 Or iMonth = 2 Then
If IntToSimDay__$(i, 2) = "十一月" Or IntToSimDay__$(i, 2) = "十二月" Then
Y = Y - 1
End If
End If
While (Y - 1900) >= 12 '地支
Y = Y - 12
Wend
rZhi = Zhi(Y - 1900)
lunCalYear = rGan & rZhi & "年"
End Function
--------------------------------------------------------------------------------
Function TwelveAnimals(i, iYear, iMonth) '十二生肖年
Dim Ani()
Ani = Array("鼠", "牛", "虎", "兔", "龍", "蛇", "馬", "羊", "猴", "雞", "狗", "豬")
Y = iYear
If iMonth = 1 Or iMonth = 2 Then
If IntToSimDay__$(i, 2) = "十一月" Or IntToSimDay__$(i, 2) = "十二月" Then
Y = Y - 1
End If
End If
While (Y - 1900) >= 12
Y = Y - 12
Wend
TwelveAnimals = "[" & Ani(Y - 1900) & "]"
End Function
Private Sub Calendar1_Click()
MsgBox ChineCalender(Calendar1.Value)
End Sub
--------------------------------------------------------------------------------
Private Sub UserForm_Initialize()
Calendar1 = Now()
End
說明:
Function ChineCalender(iDate) 函數的運用說明如下
在工作表中直接使用本函數:例如在 A2儲存格中輸入 2004/8/18 轉換農曆年格式可直接在 B2儲存格入公式 =ChineCalender(A2)
則程式碼回傳回 甲申年[猴]七月初三
在程式中呼叫自訂函數:如範例中的 MsgBox ChineCalender(Calendar1.Value)
ChineCalender 函數包含了 天干地支年、十二生肖年、農曆月、農曆日、24節氣等五個參數，這五個參數可以自由的搭配使用
例如要取得的農曆年格式為 民國九十三年七月初三 則參數組合如下
Intyear = "民國" & Application.WorksheetFunction.Text(iYear - 1911, "[DBNum1];@") & "年"
ChineCalender = Intyear & IntToSimDay__$(iDay - 1, 2) _
& IntToSimDay__$(iDay - 1, 3) & IntToSimDay__$(iDay, 4)
例如要取得的農曆年格式為 甲申年七月初三 則參數組合如下
ChineCalender = IntToSimDay__$(iDay - 1, 0) & IntToSimDay__$(iDay - 1, 2) _
& IntToSimDay__$(iDay - 1, 3) & IntToSimDay__$(iDay, 4)
例如要取得的農曆年格式為 七月初三 則參數組合如下
ChineCalender = IntToSimDay__$(iDay - 1, 2) & IntToSimDay__$(iDay - 1, 3)
|