vb.net农历计算,vb 农历

"一个关于VB的农历算法－转自CSDN "在Excel如何使用?

Option Explicit

创新互联公司制作网站网页找三站合一网站制作公司,专注于网页设计,网站建设、成都网站制作,网站设计,企业网站搭建,网站开发,建网站业务,680元做网站,已为数千家服务,创新互联公司网站建设将一如既往的为我们的客户提供最优质的网站建设、网络营销推广服务!

Dim WeekName(7), MonthAdd(11), NongliData(99), TianGan(9), DiZhi(11), ShuXia

ng(11), DayName(30), MonName(12)

Dim curTime, curYear, curMonth, curDay, curWeekday

Dim GongliStr, WeekdayStr, NongliStr, NongliDayStr

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

Private Sub Form_Load()

'获取当前系统时间

curTime = Now()

'星期名

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 + Mont

hAdd(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(((curYea

r - 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)

MsgBox NongliStr NongliDayStr

End Sub

实现阳历转阴历算法

下面是一个关于VB的农历算法

'日期数据定义方法如下

'前12个字节代表1-12月为大月或是小月，1为大月30天，0为小月29天；

'第13位为闰月的情况，1为大月30天，0为小月29天；

'第14位为闰月的月份，如果不是闰月为0，否则给出月份，10、11、12分别用A、B、C来表示，即使用16进制；

'最后4位为当年家农历新年-即农历1月1日所在公历的日期，如0131代表1月31日。

Function GetChgDate(ByVal vDate As String, ByVal ChgType As 转换方式) As String

Dim vvdate() As String = Split(vDate, "-")

If vvdate(0) 2011 Or vvdate(0) 1900 Then

Throw New NotSupportedException("本函数只提供1900年至2011年的日历转换！")

End If

Dim AddMonth, AddDay, AddYear, getDay, i As Integer

Dim RunYue As Boolean

Dim conDate As DateTime

Dim daList(2011) As String

daList(1900) = "010010110110180131"

daList(1901) = "010010101110000219"

daList(1902) = "101001010111000208"

daList(1903) = "010100100110150129"

daList(1904) = "110100100110000216"

daList(1905) = "110110010101000204"

daList(1906) = "011010101010140125"

daList(1907) = "010101101010000213"

daList(1908) = "100110101101000202"

daList(1909) = "010010101110120122"

daList(1910) = "010010101110000210"

daList(1911) = "101001001101160130"

daList(1912) = "101001001101000218"

daList(1913) = "110100100101000206"

daList(1914) = "110101010100150126"

daList(1915) = "101101010101000214"

daList(1916) = "010101101010000204"

daList(1917) = "100101101101020123"

daList(1918) = "100101011011000211"

daList(1919) = "010010011011170201"

daList(1920) = "010010011011000220"

daList(1921) = "101001001011000208"

daList(1922) = "101100100101150128"

daList(1923) = "011010100101000216"

daList(1924) = "011011010100000205"

daList(1925) = "101011011010140124"

daList(1926) = "001010110110000213"

daList(1927) = "100101010111000202"

daList(1928) = "010010010111120123"

daList(1929) = "010010010111000210"

daList(1930) = "011001001011060130"

daList(1931) = "110101001010000217"

daList(1932) = "111010100101000206"

daList(1933) = "011011010100150126"

daList(1934) = "010110101101000214"

daList(1935) = "001010110110000204"

daList(1936) = "100100110111030124"

daList(1937) = "100100101110000211"

daList(1938) = "110010010110170131"

daList(1939) = "110010010101000219"

daList(1940) = "110101001010000208"

daList(1941) = "110110100101060127"

daList(1942) = "101101010101000215"

daList(1943) = "010101101010000205"

daList(1944) = "101010101101140125"

daList(1945) = "001001011101000213"

daList(1946) = "100100101101000202"

daList(1947) = "110010010101120122"

daList(1948) = "101010010101000210"

daList(1949) = "101101001010170129"

daList(1950) = "011011001010000217"

daList(1951) = "101101010101000206"

daList(1952) = "010101011010150127"

daList(1953) = "010011011010000214"

daList(1954) = "101001011011000203"

daList(1955) = "010100101011130124"

daList(1956) = "010100101011000212"

daList(1957) = "101010010101080131"

daList(1958) = "111010010101000218"

daList(1959) = "011010101010000208"

daList(1960) = "101011010101060128"

daList(1961) = "101010110101000215"

daList(1962) = "010010110110000205"

daList(1963) = "101001010111040125"

daList(1964) = "101001010111000213"

daList(1965) = "010100100110000202"

daList(1966) = "111010010011030121"

daList(1967) = "110110010101000209"

daList(1968) = "010110101010170130"

daList(1969) = "010101101010000217"

daList(1970) = "100101101101000206"

daList(1971) = "010010101110150127"

daList(1972) = "010010101101000215"

daList(1973) = "101001001101000203"

daList(1974) = "110100100110140123"

daList(1975) = "110100100101000211"

daList(1976) = "110101010010180131"

daList(1977) = "101101010100000218"

daList(1978) = "101101101010000207"

daList(1979) = "100101101101060128"

daList(1980) = "100101011011000216"

daList(1981) = "010010011011000205"

daList(1982) = "101001001011140125"

daList(1983) = "101001001011000213"

daList(1984) = "1011001001011A0202"

daList(1985) = "011010100101000220"

daList(1986) = "011011010100000209"

daList(1987) = "101011011010060129"

daList(1988) = "101010110110000217"

daList(1989) = "100100110111000206"

daList(1990) = "010010010111150127"

daList(1991) = "010010010111000215"

daList(1992) = "011001001011000204"

daList(1993) = "011010100101030123"

daList(1994) = "111010100101000210"

daList(1995) = "011010110010180131"

daList(1996) = "010110101100000219"

daList(1997) = "101010110110000207"

daList(1998) = "100100110110150128"

daList(1999) = "100100101110000216"

daList(2000) = "110010010110000205"

daList(2001) = "110101001010140124"

daList(2002) = "110101001010000212"

daList(2003) = "110110100101000201"

daList(2004) = "010110101010120122"

daList(2005) = "010101101010000209"

daList(2006) = "101010101101170129"

daList(2007) = "001001011101000218"

daList(2008) = "100100101101000207"

daList(2009) = "110010010101150126"

daList(2010) = "101010010101000214"

daList(2011) = "101101001010000214"

AddYear = vvdate(0)

If ChgType = 转换方式.阴历转阳历 Then

AddMonth = Val(Mid(daList(AddYear), 15, 2))

AddDay = Val(Mid(daList(AddYear), 17, 2))

conDate = DateSerial(AddYear, AddMonth, AddDay)

AddDay = vvdate(2)

For i = 1 To vvdate(1) - 1

AddDay = AddDay + 29 + Val(Mid(daList(vvdate(0)), i, 1))

Next i

Return DateAdd(DateInterval.Day, AddDay - 1, conDate)

Else

CHUSHIHUA:

AddMonth = Val(Mid(daList(AddYear), 15, 2))

AddDay = Val(Mid(daList(AddYear), 17, 2))

conDate = DateSerial(AddYear, AddMonth, AddDay)

Dim vtDate As DateTime

Try

vtDate = CType(vDate, DateTime)

Catch ex As Exception

Throw New NotSupportedException("阳历日期输入错误！")

End Try

getDay = DateDiff(DateInterval.Day, conDate, vtDate)

If getDay 0 Then AddYear = AddYear - 1 : GoTo CHUSHIHUA

AddDay = 1

AddMonth = 1

For i = 1 To getDay

AddDay = AddDay + 1

If AddDay = 30 + Mid(daList(AddYear), AddMonth, 1) Or (RunYue And AddDay = 30 + Mid(daList(AddYear), 13, 1)) Then

If RunYue = False And AddMonth = Val("H" Mid(daList(AddYear), 14, 1)) Then

RunYue = True

Else

RunYue = False

AddMonth = AddMonth + 1

End If

AddDay = 1

End If

Next

Return AddYear "-" AddMonth "-" AddDay

End If

End Function

Enum 转换方式

阴历转阳历 = 1

阳历转阴历 = 0

End Enum

VB 农历的计算方法

'下面是一个关于VB的农历算法

'提供基本计算方法，具体应用自己补充

'日期数据定义方法如下

'前12个字节代表1-12月为大月或是小月，1为大月30天，0为小月29天，

'第13位为闰月的情况，1为大月30天，0为小月29天，第14位为闰月的月

'份，如果不是闰月为0，否则给出月份，10、11、12分别用A、B、C来表

'示，即使用16进制。最后4位为当年家农历新年-即农历1月1日所在公历

'的日期，如0131代表1月31日。

'GetYLDate函数使用方式如下tYear为要输入的年，tMonth为月，tDay为

'日期，YLyear是返回值，返加农历的年份，如甲子年，YLShuXing返回

'的是属象，如鼠。IsGetGl是设置是不是通过农历取公历值，如果是，

'前三个返回相应的公历日期，而且返回值是一个公历日期。

Function GetYLDate(tYear As Integer, tMonth As Integer, tDay As Integer, _

YLyear As String, YLShuXing As String, _

Optional IsGetGl As Boolean) As String

On Error Resume Next

Dim daList(1900 To 2011) As String * 18

Dim conDate As Date, setDate As Date

Dim AddMonth As Integer, AddDay As Integer, AddYear As Integer, getDay As Integer

Dim RunYue As Boolean

If tYear 2010 Or tYear 1901 Then Exit Function '如果不是有效有日期，退出

'1900 to 1909

daList(1900) = "010010110110180131"

daList(1901) = "010010101110000219"

daList(1902) = "101001010111000208"

daList(1903) = "010100100110150129"

daList(1904) = "110100100110000216"

daList(1905) = "110110010101000204"

daList(1906) = "011010101010140125"

daList(1907) = "010101101010000213"

daList(1908) = "100110101101000202"

daList(1909) = "010010101110120122"

daList(1910) = "010010101110000210"

daList(1911) = "101001001101160130"

daList(1912) = "101001001101000218"

daList(1913) = "110100100101000206"

daList(1914) = "110101010100150126"

daList(1915) = "101101010101000214"

daList(1916) = "010101101010000204"

daList(1917) = "100101101101020123"

daList(1918) = "100101011011000211"

daList(1919) = "010010011011170201"

daList(1920) = "010010011011000220"

daList(1921) = "101001001011000208"

daList(1922) = "101100100101150128"

daList(1923) = "011010100101000216"

daList(1924) = "011011010100000205"

daList(1925) = "101011011010140124"

daList(1926) = "001010110110000213"

daList(1927) = "100101010111000202"

daList(1928) = "010010010111120123"

daList(1929) = "010010010111000210"

daList(1930) = "011001001011060130"

daList(1931) = "110101001010000217"

daList(1932) = "111010100101000206"

daList(1933) = "011011010100150126"

daList(1934) = "010110101101000214"

daList(1935) = "001010110110000204"

daList(1936) = "100100110111030124"

daList(1937) = "100100101110000211"

daList(1938) = "110010010110170131"

daList(1939) = "110010010101000219"

daList(1940) = "110101001010000208"

daList(1941) = "110110100101060127"

daList(1942) = "101101010101000215"

daList(1943) = "010101101010000205"

daList(1944) = "101010101101140125"

daList(1945) = "001001011101000213"

daList(1946) = "100100101101000202"

daList(1947) = "110010010101120122"

daList(1948) = "101010010101000210"

daList(1949) = "101101001010170129"

daList(1950) = "011011001010000217"

daList(1951) = "101101010101000206"

daList(1952) = "010101011010150127"

daList(1953) = "010011011010000214"

daList(1954) = "101001011011000203"

daList(1955) = "010100101011130124"

daList(1956) = "010100101011000212"

daList(1957) = "101010010101080131"

daList(1958) = "111010010101000218"

daList(1959) = "011010101010000208"

daList(1960) = "101011010101060128"

daList(1961) = "101010110101000215"

daList(1962) = "010010110110000205"

daList(1963) = "101001010111040125"

daList(1964) = "101001010111000213"

daList(1965) = "010100100110000202"

daList(1966) = "111010010011030121"

daList(1967) = "110110010101000209"

daList(1968) = "010110101010170130"

daList(1969) = "010101101010000217"

daList(1970) = "100101101101000206"

daList(1971) = "010010101110150127"

daList(1972) = "010010101101000215"

daList(1973) = "101001001101000203"

daList(1974) = "110100100110140123"

daList(1975) = "110100100101000211"

daList(1976) = "110101010010180131"

daList(1977) = "101101010100000218"

daList(1978) = "101101101010000207"

daList(1979) = "100101101101060128"

daList(1980) = "100101011011000216"

daList(1981) = "010010011011000205"

daList(1982) = "101001001011140125"

daList(1983) = "101001001011000213"

daList(1984) = "1011001001011A0202"

daList(1985) = "011010100101000220"

daList(1986) = "011011010100000209"

daList(1987) = "101011011010060129"

daList(1988) = "101010110110000217"

daList(1989) = "100100110111000206"

daList(1990) = "010010010111150127"

daList(1991) = "010010010111000215"

daList(1992) = "011001001011000204"

daList(1993) = "011010100101030123"

daList(1994) = "111010100101000210"

daList(1995) = "011010110010180131"

daList(1996) = "010110101100000219"

daList(1997) = "101010110110000207"

daList(1998) = "100100110110150128"

daList(1999) = "100100101110000216"

daList(2000) = "110010010110000205"

daList(2001) = "110101001010140124"

daList(2002) = "110101001010000212"

daList(2003) = "110110100101000201"

daList(2004) = "010110101010120122"

daList(2005) = "010101101010000209"

daList(2006) = "101010101101170129"

daList(2007) = "001001011101000218"

daList(2008) = "100100101101000207"

daList(2009) = "110010010101150126"

daList(2010) = "101010010101000214"

daList(2011) = "101101001010000214"

AddYear = tYear

RunYue = False

If IsGetGl Then

AddMonth = Val(Mid(daList(AddYear), 15, 2))

AddDay = Val(Mid(daList(AddYear), 17, 2))

conDate = DateSerial(AddYear, AddMonth, AddDay)

AddDay = tDay

For i = 1 To tMonth - 1

AddDay = AddDay + 29 + Val(Mid(daList(tYear), i, 1))

Next i

'MsgBox DateDiff("d", conDate, Date)

setDate = DateAdd("d", AddDay - 1, conDate)

GetYLDate = setDate

tYear = Year(setDate)

tMonth = Month(setDate)

tDay = Day(setDate)

Exit Function

End If

CHUSHIHUA:

AddMonth = Val(Mid(daList(AddYear), 15, 2))

AddDay = Val(Mid(daList(AddYear), 17, 2))

conDate = DateSerial(AddYear, AddMonth, AddDay)

setDate = DateSerial(tYear, tMonth, tDay)

getDay = DateDiff("d", conDate, setDate)

If getDay 0 Then AddYear = AddYear - 1: GoTo CHUSHIHUA

' addday = NearDay

AddDay = 1: AddMonth = 1

For i = 1 To getDay

AddDay = AddDay + 1

If AddDay = 30 + Mid(daList(AddYear), AddMonth, 1) Or (RunYue And AddDay = 30 + Mid(daList(AddYear), 13, 1)) Then

If RunYue = False And AddMonth = Val("H" Mid(daList(AddYear), 14, 1)) Then

RunYue = True

Else

RunYue = False

AddMonth = AddMonth + 1

End If

AddDay = 1

End If

Next

md$ = "初一初二初三初四初五初六初七初八初九初十十一十二十三十四十五十六十七十八十九二十廿一廿二廿三廿四廿五廿六廿七廿八廿九三十"

dd$ = Mid(md$, (AddDay - 1) * 2 + 1, 2)

mm$ = Mid("正二三四五六七八九十寒腊", AddMonth, 1) + "月"

YouGetDate = DateSerial(AddYear, AddMonth, AddDay)

tiangan$ = "甲乙丙丁戊已庚辛壬癸"

dizhi$ = "子丑寅卯辰巳午未申酉戌亥"

Dim ganzhi(0 To 59) As String * 2

For i = 0 To 59

ganzhi(i) = Mid(tiangan$, (i Mod 10) + 1, 1) + Mid(dizhi$, (i Mod 12) + 1, 1)

'ff$ = ff$ + ganzhi(i)

Next i

'MsgBox ff$, , Len(ff$)

YLyear = ganzhi((AddYear - 4) Mod 60)

shu$ = "鼠牛虎兔龙蛇马羊猴鸡狗猪"

YLShuXing = Mid(shu$, ((AddYear - 4) Mod 12) + 1, 1)

If RunYue Then mm$ = "闰" + mm$

GetYLDate = mm$ + dd$

End Function

'下面是一个使用的例子，你需要在窗体上加上一个按扭，并命名为Command1，然后将下列代码复制到窗体的代码中

Private Sub Command1_Click()

Dim ty As Integer, tm As Integer, td As Integer, yl As String, sx As String

'取公历1999年10月28日的农历日期

ty = 1999

tm = 10

td = 28

t = GetYLDate(ty, tm, td, yl, sx)

MsgBox t

MsgBox ty "-" tm "-" td " " yl " " sx

'取1999年农历十月28的公历日期

t = GetYLDate(ty, tm, td, yl, sx, True)

MsgBox t

MsgBox ty "-" tm "-" td " " yl " " sx

End Sub