?? 123.bas
字號:
Attribute VB_Name = "Module1"
'Option Explicit
Public Gan(10) As String
Public Gan1(10) As String
Public Zhi(12) As String
Public Animals(12) As String
Public solarTerm(24)
Public sTermInfo(24)
Public nStr1(12), nStr2(4)
Public monthName(12) As String
Public seaSonY(150) As String
Public yearDate(150) As String
Public lmName(13) As String, sFtv(30) As String, lFtv(30) As String
Public Sub shxing()
Gan(0) = "甲": Gan(1) = "乙": Gan(2) = "丙": Gan(3) = "丁": Gan(4) = "戊": Gan(5) = "己": Gan(6) = "庚": Gan(7) = "辛": Gan(8) = "壬": Gan(9) = "癸"
Gan1(0) = "ja": Gan1(1) = "yi": Gan1(2) = "bi": Gan1(3) = "di": Gan1(4) = "wu": Gan1(5) = "ji": Gan1(6) = "ge": Gan1(7) = "xi": Gan1(8) = "re": Gan1(9) = "ku"
Zhi(11) = "子": Zhi(0) = "丑": Zhi(1) = "寅": Zhi(2) = "卯": Zhi(3) = "辰": Zhi(4) = "巳": Zhi(5) = "午": Zhi(6) = "未": Zhi(7) = "申": Zhi(8) = "酉": Zhi(9) = "戌": Zhi(10) = "亥"
Animals(0) = "鼠": Animals(1) = "牛": Animals(2) = "虎": Animals(3) = "兔": Animals(4) = "龍": Animals(5) = "蛇": Animals(6) = "馬": Animals(7) = "羊": Animals(8) = "猴": Animals(9) = "雞": Animals(10) = "狗": Animals(11) = "豬"
'
solarTerm(0) = "小寒": solarTerm(1) = "大寒": solarTerm(2) = "立春": solarTerm(3) = "雨水": solarTerm(4) = "驚蟄": solarTerm(5) = "春分": solarTerm(6) = "清明": solarTerm(7) = "谷雨": solarTerm(8) = "立夏": solarTerm(9) = "小滿": solarTerm(10) = "芒種": solarTerm(11) = "夏至"
solarTerm(12) = "小暑": solarTerm(13) = "大暑": solarTerm(14) = "立秋": solarTerm(15) = "處暑": solarTerm(16) = "白露": solarTerm(17) = "秋分": solarTerm(18) = "寒露": solarTerm(19) = "霜降": solarTerm(20) = "立冬": solarTerm(21) = "小雪": solarTerm(22) = "大雪": solarTerm(23) = "冬至"
nStr1(0) = "日": nStr1(1) = "一": nStr1(2) = "二": nStr1(3) = "三": nStr1(4) = "四": nStr1(5) = "五": nStr1(6) = "六": nStr1(7) = "七": nStr1(8) = "八": nStr1(9) = "九": nStr1(10) = "十": nStr1(11) = "十一": nStr1(12) = "十二"
nStr2(0) = "初": nStr2(1) = "十": nStr2(2) = "廿": nStr2(3) = "卅": nStr2(4) = " "
sFtv(0) = "0101*元旦": sFtv(1) = "0214 情人節(jié)": sFtv(2) = "": sFtv(3) = "0308 婦女節(jié)": sFtv(4) = "0312 植樹節(jié)": sFtv(5) = "0315 消費者權(quán)益日": sFtv(6) = "0317 ": sFtv(7) = "0401 愚人節(jié)": sFtv(8) = "0501 勞動節(jié)": sFtv(9) = "0504 青年節(jié)": sFtv(10) = "0512 護士節(jié)": sFtv(11) = "": sFtv(12) = "0601 兒童節(jié)": sFtv(13) = ""
sFtv(14) = "0701 建黨節(jié) 香港回歸紀念": sFtv(15) = "": sFtv(16) = "0718 ": sFtv(17) = "0801 建軍節(jié)": sFtv(18) = "0808 父親節(jié)": sFtv(19) = "0909 毛澤東逝世紀念": sFtv(20) = "0910 教師節(jié)": sFtv(21) = "0928 孔子誕辰": sFtv(22) = "1001*國慶節(jié)": sFtv(23) = "1006 老人節(jié)": sFtv(24) = "1024 聯(lián)合國日": sFtv(25) = "1111 ": sFtv(26) = "1112 孫中山誕辰紀念": sFtv(27) = "1220 澳門回歸紀念": sFtv(28) = "1225 Christmas Day": sFtv(29) = "1226 毛澤東誕辰紀念"
lFtv(0) = "0101*春節(jié)": lFtv(1) = "0115 元宵節(jié)": lFtv(2) = "0505 端午節(jié)": lFtv(3) = "0707 七夕情人節(jié)": lFtv(4) = "0715 中元節(jié)": lFtv(5) = "0815 中秋節(jié)": lFtv(6) = "0909 重陽節(jié)": lFtv(7) = "1208 臘八節(jié)": lFtv(8) = "1223 小年": lFtv(9) = "0100*除夕"
monthName(0) = "JAN": monthName(1) = "FEB": monthName(2) = "MAR": monthName(3) = "APR": monthName(4) = "MAY": monthName(5) = "JUN": monthName(6) = "JUL": monthName(7) = "AUG": monthName(8) = "SEP": monthName(9) = "OCT": monthName(10) = "NOV": monthName(11) = "DEC"
seaSonY(100) = "100511031005100510061006080808080808070808070807/" '2001
seaSonY(101) = "100511040906100509060906080807080708070808070807/"
seaSonY(102) = "090511040906100509060907080807080708060907080807/"
seaSonY(103) = "090611041005110510061006080708080808070808070806/"
seaSonY(104) = "100511031005100510061006080808080808070808070807/"
seaSonY(105) = "100511040906100510060906080808080708070808070807/"
seaSonY(106) = "090511040906100509060907080807080708060907080807/"
seaSonY(107) = "090611041005110510061006080708080807070808070806/"
seaSonY(108) = "100511031005110510061006080808080808070808070807/"
seaSonY(109) = "100511040906100510060906080808080708070808070807/"
seaSonY(110) = "090511040906100509060907080807080708070907080807/"
seaSonY(111) = "090611041005110510051006080708080807070808070806/"
seaSonY(112) = "100511031005110510061006080708080808070808070807/"
seaSonY(113) = "100511040906100510060906080808080708070808070807/"
seaSonY(114) = "090511040906100509060907080807080708070907070807/"
seaSonY(115) = "090511041005110410051006080708080807070808070806/"
seaSonY(116) = "100513031005110510061006080708080808070808070807/"
seaSonY(117) = "100511041006100510060906080808080708070808070807/"
seaSonY(118) = "100511040906100509060906080807080708070907070807/"
seaSonY(119) = "090511041005110410051006090708070807070808070806/"
seaSonY(120) = "100513031005110510061006080708080808070808070806/"
seaSonY(121) = "100511041005100510060906080808080808070808070807/"
seaSonY(122) = "100511040906100509060906080807080708070907070807/"
seaSonY(123) = "090511041005110410051006090708070807070808070906/"
seaSonY(124) = "100513031005110510061006080708080808070808070806/"
seaSonY(125) = "100511031005100510061006080808080808070808070807/"
seaSonY(126) = "100511040906100509060906080807080708070808070807/"
seaSonY(127) = "090511041005110410051006090708070807070808070906/"
seaSonY(128) = "100513031005110510061006080708080808070808070806/"
seaSonY(129) = "100511031005100510061006080808080808070808070807/"
seaSonY(130) = "100511040906100509060906080807080708070808070807/"
seaSonY(131) = "090511041005110410051006090708070807070808070906/"
seaSonY(132) = "100513031005110510061006080808080808070808070806/"
seaSonY(133) = "100511031005100510061006080807080808070808070807/"
seaSonY(134) = "100511040906100510060906080808080708070808070807/"
seaSonY(135) = "090511041005110410051006090708070807070808070906/"
seaSonY(136) = "100513031005110510061006080708080808070808070806/"
seaSonY(137) = "100511031005100510061006080808080808070808070807/"
seaSonY(138) = "100511040906100510060906080808080708070808070807/"
seaSonY(139) = "090511041005110410051006090708070807070808070906/"
seaSonY(140) = "100513031005110510051006080708080807070808070806/"
seaSonY(141) = "100511031005110510061006080808080808070808070807/"
seaSonY(142) = "100511040906100510060906080808080708070808070807/"
seaSonY(143) = "090511041005110410051006090708070807080808070906/"
seaSonY(144) = "100513031005110410051006080708080807070808070806/"
seaSonY(145) = "100511031005110510061006080708080808070808070807/"
seaSonY(146) = "100511040906100510060906080808080708070808070807/"
seaSonY(147) = "090511041005110410051005090708070807080808060906/"
seaSonY(148) = "100412031005100510051006090708070807070808070806/"
seaSonY(149) = "100512031005110510061006080708080708070808070807/"
For i = 0 To 99
seaSonY(145) = "101010101010101010101010101010101010101010101010"
yearDate(i) = "0000000000000000"
Next i
yearDate(100) = "1101010010101041": yearDate(101) = "1101010010100000": yearDate(102) = "1101101001010000": yearDate(103) = "0101101010101021": yearDate(104) = "0101011010100000": yearDate(105) = "1010101011011071": yearDate(106) = "0010010111010000": yearDate(107) = "1001001011010000": yearDate(108) = "1100100101011051": yearDate(109) = "1010100101010000"
yearDate(110) = "1011010010100000": yearDate(111) = "1011010101010041": yearDate(112) = "1010110101010000": yearDate(113) = "0101010110101091": yearDate(114) = "0100101110100000": yearDate(115) = "1010010110110000": yearDate(116) = "0101001010111061": yearDate(117) = "0101001010110000": yearDate(118) = "1010100100110000": yearDate(119) = "0111010010101041"
yearDate(120) = "0110101010100000": yearDate(121) = "1010110101010000": yearDate(122) = "0100110110101021": yearDate(123) = "0100101101100000": yearDate(124) = "1010010101110061": yearDate(125) = "1010010011100000": yearDate(126) = "1101001001100000": yearDate(127) = "1110100100110051": yearDate(128) = "1101010100110000": yearDate(129) = "0101101010100000"
yearDate(130) = "0110101101010031": yearDate(131) = "1001011011010000": yearDate(132) = "0100101011101111": yearDate(133) = "0100101011010000": yearDate(134) = "1010010011010000": yearDate(135) = "1101001001011061": yearDate(136) = "1101001001010000": yearDate(137) = "1101010100100000": yearDate(138) = "1101101010100051": yearDate(139) = "1011010110100000"
yearDate(140) = "0101011011010000": yearDate(141) = "0100101011011021": yearDate(142) = "0100100110110000": yearDate(143) = "1010010010111071": yearDate(144) = "1010010010110000": yearDate(145) = "1010101001010000": yearDate(146) = "1011010100101051": yearDate(147) = "0110110100100000": yearDate(148) = "1010110110100000": yearDate(149) = "0101010110110031"
End Sub
Public Function cDay(D As Integer)
Select Case D
Case 10:
s = "初十"
Case 20:
s = "二十"
Case 30:
s = "三十"
Case Else
s = nStr2(Int(D / 10))
s = s + nStr1(D Mod 10)
End Select
cDay = s
End Function
'*******************************************************
'計算Y年一年的天數(shù) =lsdayYear ,Y的值應(yīng)在1901___2050之間
'*******************************************************
Public Function lsdayYear(y As Integer)
Dim sSum As Integer, j
sSum = 0
For j = 1 To 12
If (Mid(yearDate(y - 1901), j, 1) = "1") Then
sSum = sSum + 30
Else
sSum = sSum + 29
End If
Next j
If (Right(yearDate(y - 1901), 1) = "1") Then
If (Mid(yearDate(y - 1901), 13, 1) = "1") Then
sSum = sSum + 30
Else
sSum = sSum + 29
End If
End If
lsdayYear = sSum
End Function
Public Function sdayF(dY As Integer, dM As Integer, dD As Integer)
Dim dE As Date, dH As String, sSum1, kKk As Integer, yL As Integer, i As Integer, dJ As Date, dK
Dim lLl As String
dE = #2/19/1901#
dH = Trim(Str(dY)) + "," + Trim(Str(dM)) + "," + Trim(Str(dD))
dJ = dH
dK = dJ - dE
yL = dY - 1901
sSum1 = 0
'***************************************************
'* 計算dY年dM月dD日到1901年2月19日的農(nóng)歷的總天數(shù) *
'***************************************************
For i = 0 To yL
sSum1 = sSum1 + lsdayYear(i + 1901)
Next i
'***************************************************
If Right(yearDate(yL), 1) = "1" Then
kKk = 13
'***************************************************
'* 返回dY年dM月dD日農(nóng)歷的月份大小 *
'***************************************************
sub_For kKk, yL
Else
If Right(yearDate(yL), 1) = "0" Then
kKk = 12
sub_For1 kKk, yL
End If
End If
While (sSum1 > dK)
If (Mid(yearDate(yL), kKk, 1) = "1") Then
sSum1 = sSum1 - 30
Else
sSum1 = sSum1 - 29
End If
If sSum1 > dK Then
kKk = kKk - 1
If ((kKk = 0) And (Right(yearDate(yL - 1), 1) = "1")) Then
kKk = 13
yL = yL - 1
'***************************************************
'* 返回dY年dM月dD日農(nóng)歷的月份大小 *
'***************************************************
sub_For kKk, yL
Else
If ((kKk = 0) And (Right(yearDate(yL - 1), 1) = "0")) Then
kKk = 12
yL = yL - 1
sub_For1 kKk, yL
End If
End If
End If
Wend
'***************************************************
'* 返回dY年dM月dD日農(nóng)歷的 年份 月份 日 節(jié)氣 *
'***************************************************
If (dK - sSum1 + 1) < 10 Then
lLl = "0" + Trim(Str(dK - sSum1 + 1))
Else
lLl = Trim(Str(dK - sSum1 + 1))
End If
sdayF = Trim(Str(yL + 1901)) + "Year" + lmName(kKk) + lLl + seaSonYx(dJ)
sdayF = sdayF + llFtv(kKk, dK - sSum1 + 1)
End Function
Public Function seaSonYx(ddy As Date)
?? 快捷鍵說明
復(fù)制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -