公曆轉農曆

Public Function NongLi(Optional XX_DATE As Date)

    Dim MonthAdd(11), NongliData(99), TianGan(9), DiZhi(11),
ShuXiang(11), DayName(30), MonName(12)

    Dim curTime, curYear, curMonth, curDay

    Dim GongliStr, NongliStr, NongliDayStr

    Dim i, m, n, k, isEnd, bit, TheDate

    '獲取當前系統時間

    curTime = XX_DATE

    '天干名稱

    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

    '計算到初始時間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

    NongliStr = "農曆" & 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

        NongliDayStr = "閏" &
MonName(-1 * curMonth)

    Else

        NongliDayStr =
MonName(curMonth)

    End If

    NongliDayStr = NongliDayStr & "月"

    NongliDayStr = NongliDayStr & DayName(curDay)

    NongLi = NongliStr & NongliDayStr

End Function