Các bạn thân mến! Blog TTL đã giới thiệu thuật toán tính Âm Lịch của Hồ Ngọc Đức bằng ngôn ngữ JavaScript, Đây là thuật toán Thiên văn của quốc tế. Bạn có thể xem bài viết này tại:
Còn ở bài viết này tôi sẽ giới thiệu cho bạn thuật toán tính âm lịch của Hồ Ngọc Đức bằng ngôn ngữ Viasual Basic do Blog TTL chuyển từ ngôn JavaScript. Và File Excel Lịch Vạn Niên xây dựng từ thật toán trên và các tài liệu xem ngày tháng. Nhưng tôi sẽ giới thiệu về File Lịch Vạn Niên trước, thuật toán giới thiệu sau.
File Lịch Vạn Niên là một chương trình xử lý, tính toán một ngày dương nào đó thành ngày âm lịch và các vạn sự của ngày.
Ví dụ như ngày Dương là ngày 01 tháng 01 năm 2013, thì kết quả cơ bản từ chương trình Lịch Vạn Niên là:
- Là ngày Hoàng Đạo
- Ngày thứ 3
- Ngày theo lịch Julius: 2456294
- Ngày âm lịch: 20/11/2012 ngày Đinh Mão tháng Nhâm Tý năm Nhâm Thìn
- Mệnh ngày là Hỏa (lửa trong lò), mệnh tháng là Mộc (gỗ cây dâu), mệnh năm là Thủy (nước giữa dòng)
- Ngày này đang ở trong tiết Đông Chí (giữa đông - kinh độ mặt trời là 280.43 độ)
- Từ 23h đến 01h là giờ Canh Tý thần Tư Mệnh quản, giờ này là giờ Hắc Đạo, còn từ 01h đến 03h ....
- Ngày này thì hướng Hỷ thần là Chính Nam, Tài thần là Chính Tây, Hạc thần là Chính Nam, giờ không vong tại Dậu, Hợi, Giờ tốt: Dần, Mão, Ngọ, Mùi
- Các sao tốt chiếu trong ngày này: Nguyện Đức Hợp, Thiên Thành...
- Các sao xấu chiếu trong ngày này: Thiên Cương, Thiên Lại...
- Các phần vạn sự A, B,C,D,E,F ...
- ............................
Ngoài ra còn có thêm 3 phần là: Xem Giờ Sinh, Bát Trạch, và Ngày Đặc Biệt Của Bạn:
- Phần Xem Giờ Sinh được viết theo sách Ngọc Hạp Chánh Tông. Phần này bạn chỉ nên xem cho vui, đừng tin quá.
- Phần Bát Trạch được xây dựng dựa theo sách Phong Thủy Ứng Dụng. Phần này ứng dụng cho việc bài trí nội thất, ngoại thất.
- Phần Ngày Đặc Biệt là phần bạn nhập ngày mà bạn cần nhớ của mình vào, Lịch vạn niên khi chỉ tới ngày đó sẽ báo cho bạn. Ví dụ ngày sinh của bạn là 20/10/1984 Âm Lịch thì đến ngày 20/10 âm lịch của các năm sẽ hiện dòng nhắc sinh nhật của bạn.
Tuy nhiên bản Lịch Vạn Niên này chắc chắn không ít thì nhiều có chổ sẽ sai, nếu ai phát hiện lỗi sai sót thì comment dùm nha. Ngoài ra mong bà con bàn luận chi sẽ, góp ý để hoàn thành Lịch Vạn Niên này tốt hơn.
Ghi chú Lịch Vạn Niên này là file Excel có chứa các Macro nên bạn phải đưa chế độ bảo vệ của Excel về mức Low mới xem được. Phần Bát Trạch, nếu bạn dùng thì phải dùng Excel 2007 trở lên, excel 2003 sẽ bị lỗi.
TẢI LỊCH VẠN NIÊN
Còn đây là thuật toán:
Option Explicit ' TRAN TU LIEM
Const PI As Double = 3.14159265358979 ' Atn(1) * 4
Function jdFromDate(ByVal dd As Long, ByVal mm As Long, ByVal yy As Long) As Long
Dim a As Double, y As Long, M As Long, jd As Long
a = Fix((14 - mm) / 12)
y = yy + 4800 - a
M = mm + 12 * a - 3
jd = dd + Fix((153 * M + 2) / 5) + 365 * y _
+ Fix(y / 4) - Fix(y / 100) + Fix(y / 400) - 32045
If jd < 2299161 Then
jd = dd + Fix((153 * M + 2) / 5) + 365 * y + Fix(y / 4) - 32083
End If
jdFromDate = jd
End Function
Function jdToDate(jd)
' doi ngay july thành ngay thuong
Dim a, b, c, d, e, M, Day, Month, Year
If jd > 2299160 Then
a = jd + 32044
b = Int((4 * a + 3) / 146097)
c = a - Int((b * 146097) / 4)
Else
b = 0
c = jd + 32082
End If
d = Int((4 * c + 3) / 1461)
e = c - Int((1461 * d) / 4)
M = Int((5 * e + 2) / 153)
Day = e - Int((153 * M + 2) / 5) + 1
Month = M + 3 - 12 * Int(M / 10)
Year = b * 100 + d - 4800 + Int(M / 10)
jdToDate = DateSerial(Year, Month, Day)
End Function
Function NewMoon(ByVal k As Long) As Double
Dim T As Double, T2 As Double, T3 As Double, dr As Double
Dim Jd1 As Double, M As Double, Mpr As Double
Dim F As Double, C1 As Double, deltat As Double, JdNew As Double
T = k / 1236.85 ' Time in Julian centuries from 1900 January 0.5
T2 = T * T
T3 = T2 * T
dr = PI / 180
Jd1 = 2415020.75933 + 29.53058868 * k + 0.0001178 * T2 - 0.000000155 * T3
Jd1 = Jd1 + 0.00033 * Sin((166.56 + 132.87 * T - 0.009173 * T2) * dr)
M = 359.2242 + 29.10535608 * k - 0.0000333 * T2 - 0.00000347 * T3
Mpr = 306.0253 + 385.81691806 * k + 0.0107306 * T2 + 0.00001236 * T3
F = 21.2964 + 390.67050646 * k - 0.0016528 * T2 - 0.00000239 * T3
C1 = (0.1734 - 0.000393 * T) * Sin(M * dr) + 0.0021 * Sin(2 * dr * M)
C1 = C1 - 0.4068 * Sin(Mpr * dr) + 0.0161 * Sin(dr * 2 * Mpr)
C1 = C1 - 0.0004 * Sin(dr * 3 * Mpr)
C1 = C1 + 0.0104 * Sin(dr * 2 * F) - 0.0051 * Sin(dr * (M + Mpr))
C1 = C1 - 0.0074 * Sin(dr * (M - Mpr)) + 0.0004 * Sin(dr * (2 * F + M))
C1 = C1 - 0.0004 * Sin(dr * (2 * F - M)) - 0.0006 * Sin(dr * (2 * F + Mpr))
C1 = C1 + 0.001 * Sin(dr * (2 * F - Mpr)) + 0.0005 * Sin(dr * (2 * Mpr + M))
If (T < -11) Then
deltat = 0.001 + 0.000839 * T + 0.0002261 * T2 _
- 0.00000845 * T3 - 0.000000081 * T * T3
Else
deltat = -0.000278 + 0.000265 * T + 0.000262 * T2
End If
JdNew = Jd1 + C1 - deltat
NewMoon = JdNew
End Function
Function SunLongitude(ByVal jdn As Double) As Double
Dim T As Double, T2 As Double, dr As Double, M As Double
Dim L0 As Double, DL As Double, L As Double
T = (jdn - 2451545) / 36525
' Time in Julian centuries from 2000-01-01 12:00:00 GMT
T2 = T * T
dr = PI / 180 ' degree to radian
M = 357.5291 + 35999.0503 * T - 0.0001559 * T2 - 0.00000048 * T * T2
L0 = 280.46645 + 36000.76983 * T + 0.0003032 * T2
DL = (1.9146 - 0.004817 * T - 0.000014 * T2) * Sin(dr * M)
DL = DL + (0.019993 - 0.000101 * T) * Sin(dr * 2 * M) _
+ 0.00029 * Sin(dr * 3 * M)
L = L0 + DL ' true longitude, degree
L = L * dr
L = L - PI * 2 * (Fix(L / (PI * 2))) ' Normalize to (0, 2*PI)
SunLongitude = L
End Function
Function getSunLongitude(ByVal dayNumber As Double, ByVal timeZone As Byte) As Long
getSunLongitude = Fix(SunLongitude(dayNumber - 0.5 - timeZone / 24) / PI * 6)
End Function
Function getNewMoonDay(ByVal k As Long, ByVal timeZone As Long) As Long
getNewMoonDay = Fix(NewMoon(k) + 0.5 + timeZone / 24)
End Function
Function getLunarMonth11(ByVal yy As Long, ByVal timeZone As Long) As Long
Dim k As Long, off As Double, nm As Long, sunLong As Double
off = jdFromDate(31, 12, yy) - 2415021
k = Fix(off / 29.530588853)
nm = getNewMoonDay(k, timeZone)
sunLong = getSunLongitude(nm, timeZone) ' sun longitude at local midnight
If (sunLong >= 9) Then
nm = getNewMoonDay(k - 1, timeZone)
End If
getLunarMonth11 = nm
End Function
Function getLeapMonthOffset(ByVal a11 As Double, ByVal timeZone As Long) As Long
Dim k As Long, last As Long, Arc As Long, I As Long
k = Fix((a11 - 2415021.07699869) / 29.530588853 + 0.5)
last = 0
I = 1 ' We start with the month following lunar month 11
Arc = getSunLongitude(getNewMoonDay(k + I, timeZone), timeZone)
Do
last = Arc
I = I + 1
Arc = getSunLongitude(getNewMoonDay(k + I, timeZone), timeZone)
Loop While (Arc <> last And I < 14)
getLeapMonthOffset = I - 1
End Function
Public Function KinhDoMatTroi(gio, phut, dd, mm, yy)
'tinh kinh ?o mat troi
Dim PI, a, y, M, T, jdn, L0, jd, c, theta, lambda
PI = 4 * Atn(1)
a = Int((14 - mm) / 12)
y = yy + 4800 - a
M = mm + 12 * a - 3
jdn = dd + Int(((153 * M) + 2) / 5) + 365 * y + Int(y / 4) - Int(y / 100) + Int(y / 400) - 32045
If jdn < 2299161 Then jdn = dd + Int((153 * M + 2) / 5) + 365 * y + Int(y / 4) - 32083
jd = jdn + ((gio - 12) / 24) + (phut / 1440) - 7 / 24
T = (jd - 2451545#) / 36525
L0 = 280.46645 + 36000.76983 * T + 0.0003032 * T * T
M = (357.5291 + 35999.0503 * T - 0.0001559 * T * T - 0.00000048 * T * T * T) * PI / 180
c = ((1.9146 - 0.004817 * T - 0.000014 * T * T) * Sin(M)) + (0.01993 - 0.000101 * T) * Sin(2 * M) + 0.00029 * Sin(3 * M)
theta = L0 + c
lambda = theta - 0.00569 - 0.00478 * Sin((125.04 - 1934.136 * T) * PI / 180)
lambda = lambda - 360 * Int(lambda / 360)
KinhDoMatTroi = lambda
End Function
Function convertSolar2Lunar(dd, mm, yy, timeZone)
'Doi ngày duong dd/mm/yyyy ra ngày âm
Dim k, dayNumber, monthStart, a11, b11, lunarDay, lunarMonth, lunarYear, lunarLeap, diff, leapMonthDiff
dayNumber = jdFromDate(dd, mm, yy)
k = Int((dayNumber - 2415021.07699869) / 29.530588853)
monthStart = getNewMoonDay(k + 1, timeZone)
If monthStart > dayNumber Then monthStart = getNewMoonDay(k, timeZone)
a11 = getLunarMonth11(yy, timeZone)
b11 = a11
If a11 >= monthStart Then
lunarYear = yy
a11 = getLunarMonth11(yy - 1, timeZone)
Else
lunarYear = yy + 1
b11 = getLunarMonth11(yy + 1, timeZone)
End If
lunarDay = dayNumber - monthStart + 1
diff = Int((monthStart - a11) / 29)
lunarLeap = 0
lunarMonth = diff + 11
If (b11 - a11) > 365 Then
leapMonthDiff = getLeapMonthOffset(a11, timeZone)
If diff >= leapMonthDiff Then
lunarMonth = diff + 10
If diff = leapMonthDiff Then lunarLeap = 1
End If
End If
If lunarMonth > 12 Then lunarMonth = lunarMonth - 12
If (lunarMonth >= 11 And diff < 4) Then lunarYear = lunarYear - 1
convertSolar2Lunar = lunarDay & "/" & lunarMonth & "/" & lunarYear
End Function
Function THANGNODU(dd, mm, yy, timeZone)
'THANG NO DU
Dim k, dayNumber, monthStart, a11, b11, lunarDay, lunarMonth, lunarYear, lunarLeap, diff, leapMonthDiff
dayNumber = jdFromDate(dd, mm, yy)
k = Int((dayNumber - 2415021.07699869) / 29.530588853)
monthStart = getNewMoonDay(k + 1, timeZone)
If monthStart > dayNumber Then monthStart = getNewMoonDay(k, timeZone)
a11 = getLunarMonth11(yy, timeZone)
b11 = a11
If a11 >= monthStart Then
lunarYear = yy
a11 = getLunarMonth11(yy - 1, timeZone)
Else
lunarYear = yy + 1
b11 = getLunarMonth11(yy + 1, timeZone)
End If
lunarDay = dayNumber - monthStart + 1
diff = Int((monthStart - a11) / 29)
lunarLeap = 0
lunarMonth = diff + 11
If (b11 - a11) > 365 Then
leapMonthDiff = getLeapMonthOffset(a11, timeZone)
If diff >= leapMonthDiff Then
lunarMonth = diff + 10
If diff = leapMonthDiff Then lunarLeap = 1
End If
End If
If lunarMonth > 12 Then lunarMonth = lunarMonth - 12
If (lunarMonth >= 11 And diff < 4) Then lunarYear = lunarYear - 1
THANGNODU = getNewMoonDay(k + 1, timeZone) - getNewMoonDay(k, timeZone)
End Function
Function THANGNHUAN(dd, mm, yy, timeZone)
'THANG NHUAN
Dim k, dayNumber, monthStart, a11, b11, lunarDay, lunarMonth, lunarYear, lunarLeap, diff, leapMonthDiff
dayNumber = jdFromDate(dd, mm, yy)
k = Int((dayNumber - 2415021.07699869) / 29.530588853)
monthStart = getNewMoonDay(k + 1, timeZone)
If monthStart > dayNumber Then monthStart = getNewMoonDay(k, timeZone)
a11 = getLunarMonth11(yy, timeZone)
b11 = a11
If a11 >= monthStart Then
lunarYear = yy
a11 = getLunarMonth11(yy - 1, timeZone)
Else
lunarYear = yy + 1
b11 = getLunarMonth11(yy + 1, timeZone)
End If
lunarDay = dayNumber - monthStart + 1
diff = Int((monthStart - a11) / 29)
lunarLeap = 0
lunarMonth = diff + 11
If (b11 - a11) > 365 Then
leapMonthDiff = getLeapMonthOffset(a11, timeZone)
THANGNHUAN = (leapMonthDiff + 10) Mod 12
End If
End Function
Function convertLunar2Solar(lunarDay, lunarMonth, lunarYear, lunarLeap, timeZone)
'Doi âm lich ra duong lich
Dim k, a11, b11, off, leapOff, leapMonth, monthStart
If (lunarMonth < 11) Then
a11 = getLunarMonth11(lunarYear - 1, timeZone)
b11 = getLunarMonth11(lunarYear, timeZone)
Else
a11 = getLunarMonth11(lunarYear, timeZone)
b11 = getLunarMonth11(lunarYear + 1, timeZone)
End If
off = lunarMonth - 11
If (off < 0) Then off = off + 12
If (b11 - a11 > 365) Then
leapOff = getLeapMonthOffset(a11, timeZone)
leapMonth = leapOff - 2
If (leapMonth < 0) Then leapMonth = leapMonth + 12
If (lunarLeap <> 0 And lunarMonth <> leapMonth) Then
convertLunar2Solar = Array(0, 0, 0)
Else
If (lunarLeap <> 0 Or off >= leapOff) Then off = off + 1
End If
End If
k = Int(0.5 + (a11 - 2415021.07699869) / 29.530588853)
monthStart = getNewMoonDay(k + off, timeZone)
convertLunar2Solar = jdToDate(monthStart + lunarDay - 1)
End Function
Function Ngay(dd, mm, yy, timeZone)
'Doi ngày duong dd/mm/yyyy ra ngày âm: Ngay
Dim k, dayNumber, monthStart, a11, b11, lunarDay, lunarMonth, lunarYear, lunarLeap, diff, leapMonthDiff
dayNumber = jdFromDate(dd, mm, yy)
k = Int((dayNumber - 2415021.07699869) / 29.530588853)
monthStart = getNewMoonDay(k + 1, timeZone)
If monthStart > dayNumber Then monthStart = getNewMoonDay(k, timeZone)
a11 = getLunarMonth11(yy, timeZone)
b11 = a11
If a11 >= monthStart Then
lunarYear = yy
a11 = getLunarMonth11(yy - 1, timeZone)
Else
lunarYear = yy + 1
b11 = getLunarMonth11(yy + 1, timeZone)
End If
lunarDay = dayNumber - monthStart + 1
diff = Int((monthStart - a11) / 29)
lunarLeap = 0
lunarMonth = diff + 11
If (b11 - a11) > 365 Then
leapMonthDiff = getLeapMonthOffset(a11, timeZone)
If diff >= leapMonthDiff Then
lunarMonth = diff + 10
If diff = leapMonthDiff Then lunarLeap = 1
End If
End If
If lunarMonth > 12 Then lunarMonth = lunarMonth - 12
If (lunarMonth >= 11 And diff < 4) Then lunarYear = lunarYear - 1
Ngay = lunarDay
End Function
Function Thang(dd, mm, yy, timeZone)
'Doi ngày duong dd/mm/yyyy ra ngày âm: Thang
Dim k, dayNumber, monthStart, a11, b11, lunarDay, lunarMonth, lunarYear, lunarLeap, diff, leapMonthDiff
dayNumber = jdFromDate(dd, mm, yy)
k = Int((dayNumber - 2415021.07699869) / 29.530588853)
monthStart = getNewMoonDay(k + 1, timeZone)
If monthStart > dayNumber Then monthStart = getNewMoonDay(k, timeZone)
a11 = getLunarMonth11(yy, timeZone)
b11 = a11
If a11 >= monthStart Then
lunarYear = yy
a11 = getLunarMonth11(yy - 1, timeZone)
Else
lunarYear = yy + 1
b11 = getLunarMonth11(yy + 1, timeZone)
End If
lunarDay = dayNumber - monthStart + 1
diff = Int((monthStart - a11) / 29)
lunarLeap = 0
lunarMonth = diff + 11
If (b11 - a11) > 365 Then
leapMonthDiff = getLeapMonthOffset(a11, timeZone)
If diff >= leapMonthDiff Then
lunarMonth = diff + 10
If diff = leapMonthDiff Then lunarLeap = 1
End If
End If
If lunarMonth > 12 Then lunarMonth = lunarMonth - 12
If (lunarMonth >= 11 And diff < 4) Then lunarYear = lunarYear - 1
Thang = lunarMonth
End Function
Function Nam(dd, mm, yy, timeZone)
'Doi ngày duong dd/mm/yyyy ra ngày âm
Dim k, dayNumber, monthStart, a11, b11, lunarDay, lunarMonth, lunarYear, lunarLeap, diff, leapMonthDiff
dayNumber = jdFromDate(dd, mm, yy)
k = Int((dayNumber - 2415021.07699869) / 29.530588853)
monthStart = getNewMoonDay(k + 1, timeZone)
If monthStart > dayNumber Then monthStart = getNewMoonDay(k, timeZone)
a11 = getLunarMonth11(yy, timeZone)
b11 = a11
If a11 >= monthStart Then
lunarYear = yy
a11 = getLunarMonth11(yy - 1, timeZone)
Else
lunarYear = yy + 1
b11 = getLunarMonth11(yy + 1, timeZone)
End If
lunarDay = dayNumber - monthStart + 1
diff = Int((monthStart - a11) / 29)
lunarLeap = 0
lunarMonth = diff + 11
If (b11 - a11) > 365 Then
leapMonthDiff = getLeapMonthOffset(a11, timeZone)
If diff >= leapMonthDiff Then
lunarMonth = diff + 10
If diff = leapMonthDiff Then lunarLeap = 1
End If
End If
If lunarMonth > 12 Then lunarMonth = lunarMonth - 12
If (lunarMonth >= 11 And diff < 4) Then lunarYear = lunarYear - 1
Nam = lunarYear
End Function
Function Duongcongkynhat(dd, mm, yy, timeZone)
'Doi ngày duong dd/mm/yyyy ra ngày âm
Dim k, dayNumber, monthStart, a11, b11, lunarDay, lunarMonth, lunarYear, lunarLeap, NgayAm, diff, leapMonthDiff
dayNumber = jdFromDate(dd, mm, yy)
k = Int((dayNumber - 2415021.07699869) / 29.530588853)
monthStart = getNewMoonDay(k + 1, timeZone)
If monthStart >= dayNumber Then monthStart = getNewMoonDay(k, timeZone)
a11 = getLunarMonth11(yy, timeZone)
b11 = a11
If a11 >= monthStart Then
lunarYear = yy
a11 = getLunarMonth11(yy - 1, timeZone)
Else
lunarYear = yy + 1
b11 = getLunarMonth11(yy + 1, timeZone)
End If
lunarDay = dayNumber - monthStart + 1
diff = Int((monthStart - a11) / 29)
lunarLeap = 0
lunarMonth = diff + 11
If (b11 - a11) > 365 Then
leapMonthDiff = getLeapMonthOffset(a11, timeZone)
If diff >= leapMonthDiff Then
lunarMonth = diff + 10
If diff = leapMonthDiff Then lunarLeap = 1
End If
End If
If lunarMonth > 12 Then lunarMonth = lunarMonth - 12
If (lunarMonth >= 11 And diff < 4) Then lunarYear = lunarYear - 1
NgayAm = lunarDay & "/" & lunarMonth
Duongcongkynhat = ""
If NgayAm = "13/1" Or NgayAm = "11/2" Or NgayAm = "9/3" Or NgayAm = "7/4" Or NgayAm = "5/5" Or NgayAm = "3/6" Or NgayAm = "8/7" Or NgayAm = "29/7" Or NgayAm = "27/8" Or NgayAm = "25/9" Or NgayAm = "23/10" Or NgayAm = "21/11" Or NgayAm = "19/12" Then Duongcongkynhat = 1
End Function
Function TamNuongSat(dd, mm, yy, timeZone)
'Kiem tra ngay dd/mm/yyyy có phai ngay Tam Nuong Sat
Dim k, dayNumber, monthStart, a11, b11, lunarDay, lunarMonth, lunarYear, lunarLeap, TamNuong, diff, leapMonthDiff
dayNumber = jdFromDate(dd, mm, yy)
k = Int((dayNumber - 2415021.07699869) / 29.530588853)
monthStart = getNewMoonDay(k + 1, timeZone)
If monthStart >= dayNumber Then monthStart = getNewMoonDay(k, timeZone)
a11 = getLunarMonth11(yy, timeZone)
b11 = a11
If a11 >= monthStart Then
lunarYear = yy
a11 = getLunarMonth11(yy - 1, timeZone)
Else
lunarYear = yy + 1
b11 = getLunarMonth11(yy + 1, timeZone)
End If
lunarDay = dayNumber - monthStart + 1
diff = Int((monthStart - a11) / 29)
lunarLeap = 0
lunarMonth = diff + 11
If (b11 - a11) > 365 Then
leapMonthDiff = getLeapMonthOffset(a11, timeZone)
If diff >= leapMonthDiff Then
lunarMonth = diff + 10
If diff = leapMonthDiff Then lunarLeap = 1
End If
End If
If lunarMonth > 12 Then lunarMonth = lunarMonth - 12
If (lunarMonth >= 11 And diff < 4) Then lunarYear = lunarYear - 1
TamNuongSat = ""
If lunarDay = 2 Or lunarDay = 7 Or lunarDay = 13 Or lunarDay = 18 Or lunarDay = 22 Or lunarDay = 27 Then TamNuongSat = 1
End Function
Function NgayNguyetKy(dd, mm, yy, timeZone)
'Kiem tra ngay dd/mm/yyyy có phai ngay Nguyet Ky
Dim k, dayNumber, monthStart, a11, b11, lunarDay, lunarMonth, lunarYear, lunarLeap, TamNuong, diff, leapMonthDiff
dayNumber = jdFromDate(dd, mm, yy)
k = Int((dayNumber - 2415021.07699869) / 29.530588853)
monthStart = getNewMoonDay(k + 1, timeZone)
If monthStart >= dayNumber Then monthStart = getNewMoonDay(k, timeZone)
a11 = getLunarMonth11(yy, timeZone)
b11 = a11
If a11 >= monthStart Then
lunarYear = yy
a11 = getLunarMonth11(yy - 1, timeZone)
Else
lunarYear = yy + 1
b11 = getLunarMonth11(yy + 1, timeZone)
End If
lunarDay = dayNumber - monthStart + 1
diff = Int((monthStart - a11) / 29)
lunarLeap = 0
lunarMonth = diff + 11
If (b11 - a11) > 365 Then
leapMonthDiff = getLeapMonthOffset(a11, timeZone)
If diff >= leapMonthDiff Then
lunarMonth = diff + 10
If diff = leapMonthDiff Then lunarLeap = 1
End If
End If
If lunarMonth > 12 Then lunarMonth = lunarMonth - 12
If (lunarMonth >= 11 And diff < 4) Then lunarYear = lunarYear - 1
NgayNguyetKy = ""
If lunarDay = 5 Or lunarDay = 14 Or lunarDay = 23 Then NgayNguyetKy = 1
End Function
Public Function KIMMATTROI(q)
Worksheets("HOME").Shapes("KIM").Rotation = q
End Function
Public Function KIMLABAN(q)
Worksheets("BATTRACH").Shapes("KIM2").Rotation = q
End Function
Public Function xoay(q)
Worksheets("BATTRACH").Shapes("Re5").Rotation = q
End Function
Public Function DIEMHUONG()
Dim b1, b2, b3, b4, b5, b6, b7, b8
b1 = Application.Worksheets("Data").Range("BXX1")
b2 = Application.Worksheets("Data").Range("BXX2")
b3 = Application.Worksheets("Data").Range("BXX33")
b4 = Application.Worksheets("Data").Range("BXX4")
b5 = Application.Worksheets("Data").Range("BXX5")
b6 = Application.Worksheets("Data").Range("BXX6")
b7 = Application.Worksheets("Data").Range("BXX7")
b8 = Application.Worksheets("Data").Range("BXX8")
Worksheets("BATTRACH").Shapes("BAC").TextFrame.Characters.Text = b1
Worksheets("BATTRACH").Shapes("DB").TextFrame.Characters.Text = b2
Worksheets("BATTRACH").Shapes("DONG").TextFrame.Characters.Text = b3
Worksheets("BATTRACH").Shapes("DN").TextFrame.Characters.Text = b4
Worksheets("BATTRACH").Shapes("NM").TextFrame.Characters.Text = b5
Worksheets("BATTRACH").Shapes("TN").TextFrame.Characters.Text = b6
Worksheets("BATTRACH").Shapes("TAY").TextFrame.Characters.Text = b7
Worksheets("BATTRACH").Shapes("TB").TextFrame.Characters.Text = b8
End Function
Public Function HAITUHUONG()
Dim b1, b2, b3, b4, b5, b6, b7, b8, b9, b10, b11, b12, b13, b14, b15, b16, b17, b18, b19, b20, b21, b22, b23, b24
b1 = Application.Worksheets("Data").Range("WW1")
b2 = Application.Worksheets("Data").Range("WW2")
b3 = Application.Worksheets("Data").Range("WW3")
b4 = Application.Worksheets("Data").Range("WW4")
b5 = Application.Worksheets("Data").Range("WW5")
b6 = Application.Worksheets("Data").Range("WW6")
b7 = Application.Worksheets("Data").Range("WW7")
b8 = Application.Worksheets("Data").Range("WW8")
b9 = Application.Worksheets("Data").Range("WW9")
b10 = Application.Worksheets("Data").Range("WW10")
b11 = Application.Worksheets("Data").Range("WW11")
b12 = Application.Worksheets("Data").Range("WW12")
b13 = Application.Worksheets("Data").Range("WW13")
b14 = Application.Worksheets("Data").Range("WW14")
b15 = Application.Worksheets("Data").Range("WW15")
b16 = Application.Worksheets("Data").Range("WW16")
b17 = Application.Worksheets("Data").Range("WW17")
b18 = Application.Worksheets("Data").Range("WW18")
b19 = Application.Worksheets("Data").Range("WW19")
b20 = Application.Worksheets("Data").Range("WW20")
b21 = Application.Worksheets("Data").Range("WW21")
b22 = Application.Worksheets("Data").Range("WW22")
b23 = Application.Worksheets("Data").Range("WW23")
b24 = Application.Worksheets("Data").Range("WW24")
Worksheets("BATTRACH").Shapes("qq1").TextFrame.Characters.Text = b1
Worksheets("BATTRACH").Shapes("qq2").TextFrame.Characters.Text = b2
Worksheets("BATTRACH").Shapes("qq3").TextFrame.Characters.Text = b3
Worksheets("BATTRACH").Shapes("qq4").TextFrame.Characters.Text = b4
Worksheets("BATTRACH").Shapes("qq5").TextFrame.Characters.Text = b5
Worksheets("BATTRACH").Shapes("qq6").TextFrame.Characters.Text = b6
Worksheets("BATTRACH").Shapes("qq7").TextFrame.Characters.Text = b7
Worksheets("BATTRACH").Shapes("qq8").TextFrame.Characters.Text = b8
Worksheets("BATTRACH").Shapes("qq9").TextFrame.Characters.Text = b9
Worksheets("BATTRACH").Shapes("qq10").TextFrame.Characters.Text = b10
Worksheets("BATTRACH").Shapes("qq11").TextFrame.Characters.Text = b11
Worksheets("BATTRACH").Shapes("qq12").TextFrame.Characters.Text = b12
Worksheets("BATTRACH").Shapes("qq13").TextFrame.Characters.Text = b13
Worksheets("BATTRACH").Shapes("qq14").TextFrame.Characters.Text = b14
Worksheets("BATTRACH").Shapes("qq15").TextFrame.Characters.Text = b15
Worksheets("BATTRACH").Shapes("qq16").TextFrame.Characters.Text = b16
Worksheets("BATTRACH").Shapes("qq17").TextFrame.Characters.Text = b17
Worksheets("BATTRACH").Shapes("qq18").TextFrame.Characters.Text = b18
Worksheets("BATTRACH").Shapes("qq19").TextFrame.Characters.Text = b19
Worksheets("BATTRACH").Shapes("qq20").TextFrame.Characters.Text = b20
Worksheets("BATTRACH").Shapes("qq21").TextFrame.Characters.Text = b21
Worksheets("BATTRACH").Shapes("qq22").TextFrame.Characters.Text = b22
Worksheets("BATTRACH").Shapes("qq23").TextFrame.Characters.Text = b23
Worksheets("BATTRACH").Shapes("qq24").TextFrame.Characters.Text = b24
End Function
Public Function RunBATTRACH()
Dim goc
Run DIEMHUONG()
Run HAITUHUONG()
goc = Application.Worksheets("Battrach").Range("gocH")
Run KIMLABAN(goc)
Run xoay(goc)
End Function
LỊCH VẠN NIÊN TTL-EXCEL | DOWNLOAD LỊCH VẠN NIÊN | LỊCH VẠN NIÊN | LICH VẠN NIÊN 2013
Không có nhận xét nào:
Đăng nhận xét