Skip to content

Instantly share code, notes, and snippets.

@touchiep

touchiep/ThaiDateTime.vba

Created February 29, 2024 15:53
Show Gist options
  • Save touchiep/271276ff1461ecc0cdc3cbe8581ba5a1 to your computer and use it in GitHub Desktop.
Save touchiep/271276ff1461ecc0cdc3cbe8581ba5a1 to your computer and use it in GitHub Desktop.
Download ZIP
[VBA][Excel] รวมฟังชั่นด้านวันที่และเวลาแบบไทย
Raw
ThaiDateTime.vba
Option Explicit
Private Function XLMod(a, b)
' This attempts to mimic the Excel MOD function
XLMod = a - b * Int(a / b)
End Function
Public Function AthikaMas(iYear As Integer) As Boolean
'AthikaMas calculation
'Return True if the specified year is AthikaMas.
'Inspired by Loy's Calculation
Dim Athi
Athi = XLMod((iYear - 78) - 0.45222, 2.7118886)
If Athi < 1 Then
AthikaMas = True
Else
AthikaMas = False
End If
End Function
Public Function AthikaVar(iYear As Integer) As Boolean
'AthikaVar calculation
'Return True if the specified year is AthikaVar.
'Inspired by Loy's Calculation
Dim CutOff
If AthikaMas(iYear) = True Then
AthikaVar = False
Else
If AthikaMas(iYear + 1) = True Then 'ตรวสอบปีถัดไปว่าเป็นอธิกมาสหรือไม่
CutOff = 1.69501433191599E-02 'ปีถัดไปเป็น อธิกมาส
Else
CutOff = -1.42223099315486E-02 'ปีถัดไปเป็น ปกติ
End If
If Deviation(iYear) > CutOff Then 'ถ้าค่าเบี่ยงเบนสูงกว่าค่า cutoff จะเป็นปีอธิกวาร
AthikaVar = True
Else
AthikaVar = False
End If
End If
End Function
Private Function Deviation(iYear As Integer)
'The Deviation calculation for AthikaVar from year 1901 to 2460
'Copyright 2022 and later by Pongsathorn Sraouthai
'Inspired by Loy's Calculation
Dim FDev, Fyear 'The deviation value from year 1901, Buddist Era 2444
Dim CurrDev, lastDev
Dim i As Integer, j As Integer
Dim StartY(1 To 112, 1 To 2)
StartY(1, 1) = 1901
StartY(2, 1) = 1906
StartY(3, 1) = 1911
StartY(4, 1) = 1916
StartY(5, 1) = 1921
StartY(6, 1) = 1926
StartY(7, 1) = 1931
StartY(8, 1) = 1936
StartY(9, 1) = 1941
StartY(10, 1) = 1946
StartY(11, 1) = 1951
StartY(12, 1) = 1956
StartY(13, 1) = 1961
StartY(14, 1) = 1966
StartY(15, 1) = 1971
StartY(16, 1) = 1976
StartY(17, 1) = 1981
StartY(18, 1) = 1986
StartY(19, 1) = 1991
StartY(20, 1) = 1996
StartY(21, 1) = 2001
StartY(22, 1) = 2006
StartY(23, 1) = 2011
StartY(24, 1) = 2016
StartY(25, 1) = 2021
StartY(26, 1) = 2026
StartY(27, 1) = 2031
StartY(28, 1) = 2036
StartY(29, 1) = 2041
StartY(30, 1) = 2046
StartY(31, 1) = 2051
StartY(32, 1) = 2056
StartY(33, 1) = 2061
StartY(34, 1) = 2066
StartY(35, 1) = 2071
StartY(36, 1) = 2076
StartY(37, 1) = 2081
StartY(38, 1) = 2086
StartY(39, 1) = 2091
StartY(40, 1) = 2096
StartY(41, 1) = 2101
StartY(42, 1) = 2106
StartY(43, 1) = 2111
StartY(44, 1) = 2116
StartY(45, 1) = 2121
StartY(46, 1) = 2126
StartY(47, 1) = 2131
StartY(48, 1) = 2136
StartY(49, 1) = 2141
StartY(50, 1) = 2146
StartY(51, 1) = 2151
StartY(52, 1) = 2156
StartY(53, 1) = 2161
StartY(54, 1) = 2166
StartY(55, 1) = 2171
StartY(56, 1) = 2176
StartY(57, 1) = 2181
StartY(58, 1) = 2186
StartY(59, 1) = 2191
StartY(60, 1) = 2196
StartY(61, 1) = 2201
StartY(62, 1) = 2206
StartY(63, 1) = 2211
StartY(64, 1) = 2216
StartY(65, 1) = 2221
StartY(66, 1) = 2226
StartY(67, 1) = 2231
StartY(68, 1) = 2236
StartY(69, 1) = 2241
StartY(70, 1) = 2246
StartY(71, 1) = 2251
StartY(72, 1) = 2256
StartY(73, 1) = 2261
StartY(74, 1) = 2266
StartY(75, 1) = 2271
StartY(76, 1) = 2276
StartY(77, 1) = 2281
StartY(78, 1) = 2286
StartY(79, 1) = 2291
StartY(80, 1) = 2296
StartY(81, 1) = 2301
StartY(82, 1) = 2306
StartY(83, 1) = 2311
StartY(84, 1) = 2316
StartY(85, 1) = 2321
StartY(86, 1) = 2326
StartY(87, 1) = 2331
StartY(88, 1) = 2336
StartY(89, 1) = 2341
StartY(90, 1) = 2346
StartY(91, 1) = 2351
StartY(92, 1) = 2356
StartY(93, 1) = 2361
StartY(94, 1) = 2366
StartY(95, 1) = 2371
StartY(96, 1) = 2376
StartY(97, 1) = 2381
StartY(98, 1) = 2386
StartY(99, 1) = 2391
StartY(100, 1) = 2396
StartY(101, 1) = 2401
StartY(102, 1) = 2406
StartY(103, 1) = 2411
StartY(104, 1) = 2416
StartY(105, 1) = 2421
StartY(106, 1) = 2426
StartY(107, 1) = 2431
StartY(108, 1) = 2436
StartY(109, 1) = 2441
StartY(110, 1) = 2446
StartY(111, 1) = 2451
StartY(112, 1) = 2456
StartY(1, 2) = 0.122733000004352
StartY(2, 2) = 1.91890000045229E-02
StartY(3, 2) = -8.43549999953059E-02
StartY(4, 2) = -0.187898999995135
StartY(5, 2) = -0.291442999994964
StartY(6, 2) = 7.44250000052413E-02
StartY(7, 2) = -2.91189999945876E-02
StartY(8, 2) = -0.132662999994416
StartY(9, 2) = -0.236206999994245
StartY(10, 2) = -0.339750999994074
StartY(11, 2) = -0.443294999993903
StartY(12, 2) = -7.74269999936981E-02
StartY(13, 2) = -0.180970999993527
StartY(14, 2) = -0.284514999993356
StartY(15, 2) = -0.388058999993185
StartY(16, 2) = -0.491602999993014
StartY(17, 2) = -0.595146999992842
StartY(18, 2) = -0.698690999992671
StartY(19, 2) = -0.332822999992466
StartY(20, 2) = -0.436366999992295
StartY(21, 2) = -0.539910999992124
StartY(22, 2) = -0.643454999991953
StartY(23, 2) = 0.253001000008218
StartY(24, 2) = 0.149457000008389
StartY(25, 2) = -0.484674999991406
StartY(26, 2) = -0.588218999991235
StartY(27, 2) = 0.308237000008937
StartY(28, 2) = 0.204693000009108
StartY(29, 2) = 0.101149000009279
StartY(30, 2) = -2.39499999055015E-03
StartY(31, 2) = -0.105938999990379
StartY(32, 2) = 0.259929000009826
StartY(33, 2) = 0.156385000009997
StartY(34, 2) = 5.28410000101682E-02
StartY(35, 2) = -5.07029999896607E-02
StartY(36, 2) = -0.15424699998949
StartY(37, 2) = -0.257790999989318
StartY(38, 2) = 0.108077000010887
StartY(39, 2) = 4.53300001105772E-03
StartY(40, 2) = -9.90109999887712E-02
StartY(41, 2) = -0.2025549999886
StartY(42, 2) = -0.306098999988429
StartY(43, 2) = -0.409642999988258
StartY(44, 2) = -4.37749999880528E-02
StartY(45, 2) = -0.147318999987882
StartY(46, 2) = -0.250862999987711
StartY(47, 2) = -0.354406999987539
StartY(48, 2) = -0.457950999987368
StartY(49, 2) = -0.561494999987197
StartY(50, 2) = -0.665038999987026
StartY(51, 2) = -0.299170999986821
StartY(52, 2) = -0.40271499998665
StartY(53, 2) = -0.506258999986479
StartY(54, 2) = -0.609802999986308
StartY(55, 2) = -0.713346999986137
StartY(56, 2) = 0.183109000014035
StartY(57, 2) = -0.45102299998576
StartY(58, 2) = -0.554566999985589
StartY(59, 2) = 0.341889000014582
StartY(60, 2) = 0.238345000014753
StartY(61, 2) = 0.134801000014924
StartY(62, 2) = 3.12570000150951E-02
StartY(63, 2) = -7.22869999847338E-02
StartY(64, 2) = 0.293581000015471
StartY(65, 2) = 0.190037000015642
StartY(66, 2) = 8.64930000158135E-02
StartY(67, 2) = -1.70509999840154E-02
StartY(68, 2) = -0.120594999983844
StartY(69, 2) = -0.224138999983673
StartY(70, 2) = 0.141729000016532
StartY(71, 2) = 0.038185000016703
StartY(72, 2) = -6.53589999831259E-02
StartY(73, 2) = -0.168902999982955
StartY(74, 2) = -0.272446999982784
StartY(75, 2) = -0.375990999982613
StartY(76, 2) = -1.01229999824075E-02
StartY(77, 2) = -0.113666999982236
StartY(78, 2) = -0.217210999982065
StartY(79, 2) = -0.320754999981894
StartY(80, 2) = -0.424298999981723
StartY(81, 2) = -0.527842999981552
StartY(82, 2) = -0.631386999981381
StartY(83, 2) = -0.265518999981176
StartY(84, 2) = -0.369062999981005
StartY(85, 2) = -0.472606999980834
StartY(86, 2) = -0.576150999980662
StartY(87, 2) = -0.679694999980491
StartY(88, 2) = 0.21676100001968
StartY(89, 2) = -0.417370999980115
StartY(90, 2) = -0.520914999979944
StartY(91, 2) = -0.624458999979773
StartY(92, 2) = 0.271997000020398
StartY(93, 2) = 0.168453000020569
StartY(94, 2) = 6.49090000207404E-02
StartY(95, 2) = -3.86349999790885E-02
StartY(96, 2) = 0.327233000021117
StartY(97, 2) = 0.223689000021288
StartY(98, 2) = 0.120145000021459
StartY(99, 2) = 1.66010000216299E-02
StartY(100, 2) = -0.086942999978199
StartY(101, 2) = -0.190486999978028
StartY(102, 2) = 0.175381000022177
StartY(103, 2) = 7.18370000223483E-02
StartY(104, 2) = -3.17069999774806E-02
StartY(105, 2) = -0.135250999977309
StartY(106, 2) = -0.238794999977138
StartY(107, 2) = -0.342338999976967
StartY(108, 2) = 2.35290000232378E-02
StartY(109, 2) = -8.00149999765911E-02
StartY(110, 2) = -0.18355899997642
StartY(111, 2) = -0.287102999976249
StartY(112, 2) = -0.390646999976078
Select Case iYear
Case Is >= 2456
Fyear = StartY(112, 1)
FDev = StartY(112, 2)
Case Is >= 2451
Fyear = StartY(111, 1)
FDev = StartY(111, 2)
Case Is >= 2446
Fyear = StartY(110, 1)
FDev = StartY(110, 2)
Case Is >= 2441
Fyear = StartY(109, 1)
FDev = StartY(109, 2)
Case Is >= 2436
Fyear = StartY(108, 1)
FDev = StartY(108, 2)
Case Is >= 2431
Fyear = StartY(107, 1)
FDev = StartY(107, 2)
Case Is >= 2426
Fyear = StartY(106, 1)
FDev = StartY(106, 2)
Case Is >= 2421
Fyear = StartY(105, 1)
FDev = StartY(105, 2)
Case Is >= 2416
Fyear = StartY(104, 1)
FDev = StartY(104, 2)
Case Is >= 2411
Fyear = StartY(103, 1)
FDev = StartY(103, 2)
Case Is >= 2406
Fyear = StartY(102, 1)
FDev = StartY(102, 2)
Case Is >= 2401
Fyear = StartY(101, 1)
FDev = StartY(101, 2)
Case Is >= 2396
Fyear = StartY(100, 1)
FDev = StartY(100, 2)
Case Is >= 2391
Fyear = StartY(99, 1)
FDev = StartY(99, 2)
Case Is >= 2386
Fyear = StartY(98, 1)
FDev = StartY(98, 2)
Case Is >= 2381
Fyear = StartY(97, 1)
FDev = StartY(97, 2)
Case Is >= 2376
Fyear = StartY(96, 1)
FDev = StartY(96, 2)
Case Is >= 2371
Fyear = StartY(95, 1)
FDev = StartY(95, 2)
Case Is >= 2366
Fyear = StartY(94, 1)
FDev = StartY(94, 2)
Case Is >= 2361
Fyear = StartY(93, 1)
FDev = StartY(93, 2)
Case Is >= 2356
Fyear = StartY(92, 1)
FDev = StartY(92, 2)
Case Is >= 2351
Fyear = StartY(91, 1)
FDev = StartY(91, 2)
Case Is >= 2346
Fyear = StartY(90, 1)
FDev = StartY(90, 2)
Case Is >= 2341
Fyear = StartY(89, 1)
FDev = StartY(89, 2)
Case Is >= 2336
Fyear = StartY(88, 1)
FDev = StartY(88, 2)
Case Is >= 2331
Fyear = StartY(87, 1)
FDev = StartY(87, 2)
Case Is >= 2326
Fyear = StartY(86, 1)
FDev = StartY(86, 2)
Case Is >= 2321
Fyear = StartY(85, 1)
FDev = StartY(85, 2)
Case Is >= 2316
Fyear = StartY(84, 1)
FDev = StartY(84, 2)
Case Is >= 2311
Fyear = StartY(83, 1)
FDev = StartY(83, 2)
Case Is >= 2306
Fyear = StartY(82, 1)
FDev = StartY(82, 2)
Case Is >= 2301
Fyear = StartY(81, 1)
FDev = StartY(81, 2)
Case Is >= 2296
Fyear = StartY(80, 1)
FDev = StartY(80, 2)
Case Is >= 2291
Fyear = StartY(79, 1)
FDev = StartY(79, 2)
Case Is >= 2286
Fyear = StartY(78, 1)
FDev = StartY(78, 2)
Case Is >= 2281
Fyear = StartY(77, 1)
FDev = StartY(77, 2)
Case Is >= 2276
Fyear = StartY(76, 1)
FDev = StartY(76, 2)
Case Is >= 2271
Fyear = StartY(75, 1)
FDev = StartY(75, 2)
Case Is >= 2266
Fyear = StartY(74, 1)
FDev = StartY(74, 2)
Case Is >= 2261
Fyear = StartY(73, 1)
FDev = StartY(73, 2)
Case Is >= 2256
Fyear = StartY(72, 1)
FDev = StartY(72, 2)
Case Is >= 2251
Fyear = StartY(71, 1)
FDev = StartY(71, 2)
Case Is >= 2246
Fyear = StartY(70, 1)
FDev = StartY(70, 2)
Case Is >= 2241
Fyear = StartY(69, 1)
FDev = StartY(69, 2)
Case Is >= 2236
Fyear = StartY(68, 1)
FDev = StartY(68, 2)
Case Is >= 2231
Fyear = StartY(67, 1)
FDev = StartY(67, 2)
Case Is >= 2226
Fyear = StartY(66, 1)
FDev = StartY(66, 2)
Case Is >= 2221
Fyear = StartY(65, 1)
FDev = StartY(65, 2)
Case Is >= 2216
Fyear = StartY(64, 1)
FDev = StartY(64, 2)
Case Is >= 2211
Fyear = StartY(63, 1)
FDev = StartY(63, 2)
Case Is >= 2206
Fyear = StartY(62, 1)
FDev = StartY(62, 2)
Case Is >= 2201
Fyear = StartY(61, 1)
FDev = StartY(61, 2)
Case Is >= 2196
Fyear = StartY(60, 1)
FDev = StartY(60, 2)
Case Is >= 2191
Fyear = StartY(59, 1)
FDev = StartY(59, 2)
Case Is >= 2186
Fyear = StartY(58, 1)
FDev = StartY(58, 2)
Case Is >= 2181
Fyear = StartY(57, 1)
FDev = StartY(57, 2)
Case Is >= 2176
Fyear = StartY(56, 1)
FDev = StartY(56, 2)
Case Is >= 2171
Fyear = StartY(55, 1)
FDev = StartY(55, 2)
Case Is >= 2166
Fyear = StartY(54, 1)
FDev = StartY(54, 2)
Case Is >= 2161
Fyear = StartY(53, 1)
FDev = StartY(53, 2)
Case Is >= 2156
Fyear = StartY(52, 1)
FDev = StartY(52, 2)
Case Is >= 2151
Fyear = StartY(51, 1)
FDev = StartY(51, 2)
Case Is >= 2146
Fyear = StartY(50, 1)
FDev = StartY(50, 2)
Case Is >= 2141
Fyear = StartY(49, 1)
FDev = StartY(49, 2)
Case Is >= 2136
Fyear = StartY(48, 1)
FDev = StartY(48, 2)
Case Is >= 2131
Fyear = StartY(47, 1)
FDev = StartY(47, 2)
Case Is >= 2126
Fyear = StartY(46, 1)
FDev = StartY(46, 2)
Case Is >= 2121
Fyear = StartY(45, 1)
FDev = StartY(45, 2)
Case Is >= 2116
Fyear = StartY(44, 1)
FDev = StartY(44, 2)
Case Is >= 2111
Fyear = StartY(43, 1)
FDev = StartY(43, 2)
Case Is >= 2106
Fyear = StartY(42, 1)
FDev = StartY(42, 2)
Case Is >= 2101
Fyear = StartY(41, 1)
FDev = StartY(41, 2)
Case Is >= 2096
Fyear = StartY(40, 1)
FDev = StartY(40, 2)
Case Is >= 2091
Fyear = StartY(39, 1)
FDev = StartY(39, 2)
Case Is >= 2086
Fyear = StartY(38, 1)
FDev = StartY(38, 2)
Case Is >= 2081
Fyear = StartY(37, 1)
FDev = StartY(37, 2)
Case Is >= 2076
Fyear = StartY(36, 1)
FDev = StartY(36, 2)
Case Is >= 2071
Fyear = StartY(35, 1)
FDev = StartY(35, 2)
Case Is >= 2066
Fyear = StartY(34, 1)
FDev = StartY(34, 2)
Case Is >= 2061
Fyear = StartY(33, 1)
FDev = StartY(33, 2)
Case Is >= 2056
Fyear = StartY(32, 1)
FDev = StartY(32, 2)
Case Is >= 2051
Fyear = StartY(31, 1)
FDev = StartY(31, 2)
Case Is >= 2046
Fyear = StartY(30, 1)
FDev = StartY(30, 2)
Case Is >= 2041
Fyear = StartY(29, 1)
FDev = StartY(29, 2)
Case Is >= 2036
Fyear = StartY(28, 1)
FDev = StartY(28, 2)
Case Is >= 2031
Fyear = StartY(27, 1)
FDev = StartY(27, 2)
Case Is >= 2026
Fyear = StartY(26, 1)
FDev = StartY(26, 2)
Case Is >= 2021
Fyear = StartY(25, 1)
FDev = StartY(25, 2)
Case Is >= 2016
Fyear = StartY(24, 1)
FDev = StartY(24, 2)
Case Is >= 2011
Fyear = StartY(23, 1)
FDev = StartY(23, 2)
Case Is >= 2006
Fyear = StartY(22, 1)
FDev = StartY(22, 2)
Case Is >= 2001
Fyear = StartY(21, 1)
FDev = StartY(21, 2)
Case Is >= 1996
Fyear = StartY(20, 1)
FDev = StartY(20, 2)
Case Is >= 1991
Fyear = StartY(19, 1)
FDev = StartY(19, 2)
Case Is >= 1986
Fyear = StartY(18, 1)
FDev = StartY(18, 2)
Case Is >= 1981
Fyear = StartY(17, 1)
FDev = StartY(17, 2)
Case Is >= 1976
Fyear = StartY(16, 1)
FDev = StartY(16, 2)
Case Is >= 1971
Fyear = StartY(15, 1)
FDev = StartY(15, 2)
Case Is >= 1966
Fyear = StartY(14, 1)
FDev = StartY(14, 2)
Case Is >= 1961
Fyear = StartY(13, 1)
FDev = StartY(13, 2)
Case Is >= 1956
Fyear = StartY(12, 1)
FDev = StartY(12, 2)
Case Is >= 1951
Fyear = StartY(11, 1)
FDev = StartY(11, 2)
Case Is >= 1946
Fyear = StartY(10, 1)
FDev = StartY(10, 2)
Case Is >= 1941
Fyear = StartY(9, 1)
FDev = StartY(9, 2)
Case Is >= 1936
Fyear = StartY(8, 1)
FDev = StartY(8, 2)
Case Is >= 1931
Fyear = StartY(7, 1)
FDev = StartY(7, 2)
Case Is >= 1926
Fyear = StartY(6, 1)
FDev = StartY(6, 2)
Case Is >= 1921
Fyear = StartY(5, 1)
FDev = StartY(5, 2)
Case Is >= 1916
Fyear = StartY(4, 1)
FDev = StartY(4, 2)
Case Is >= 1911
Fyear = StartY(3, 1)
FDev = StartY(3, 2)
Case Is >= 1906
Fyear = StartY(2, 1)
FDev = StartY(2, 2)
Case Is >= 1901
Fyear = StartY(1, 1)
FDev = StartY(1, 2)
Case Else
Deviation = 0
Exit Function
End Select
If iYear = Fyear Then
CurrDev = FDev
Else
Fyear = Fyear + 1
For i = Fyear To iYear
'ถ้า i = ปีเริ่มต้น ให้ใช้ข้อมูลการเบี่ยงเบนของปีเริ่มต้นมาแสดงผล
If i = Fyear Then
lastDev = FDev
Else
lastDev = CurrDev
End If
'ถ้าปีก่อนหน้าเป็นอธิกมาส
If AthikaMas(i - 1) = True Then
CurrDev = -0.102356
'ถ้าปีก่อนหน้าเป็นอธิกวาร
ElseIf AthikaVar(i - 1) = True Then
CurrDev = -0.632944
'ถ้าปีก่อนหน้าเป็นปีปกติ
Else
CurrDev = 0.367056
End If
CurrDev = lastDev + CurrDev
Next i
End If
Deviation = CurrDev
End Function
Public Function LDayInYear(iYear As Integer)
'สำหรับใช้ระบุจำนวนวารในหนึ่งปีจันทรคติ
'calculation for number in year of lunarday
'return value of lunar days in year for Thai Lunar Date
'Copyright 2022 and later by Pongsathorn Sraouthai
If AthikaMas(iYear) = True Then
LDayInYear = 384
ElseIf AthikaVar(iYear) = True Then
LDayInYear = 355
Else
LDayInYear = 354
End If
End Function
Public Function AthikaSurathin(iYear As Integer) As Boolean
'สำหรับใช้ระบุปีสุริยคติว่าเป็นปี ปกติ หรือ อธิกสุรทิน
'Calculation for leap year
'return value true if it is a leap year.
'Copyright 2022 and later by Pongsathorn Sraouthai
Dim tmp As Boolean
If iYear Mod 400 = 0 Then
tmp = True
ElseIf iYear Mod 100 = 0 Then
tmp = False
ElseIf iYear Mod 4 = 0 Then
tmp = True
Else
tmp = False
End If
AthikaSurathin = tmp
End Function
Public Function NODIYear(iYear As Integer) As Integer
'ใช้ระบุจำนวนวันในหนึ่งปีสุริยคติ
'NODIYEAR = Number of day in the year
'Amount Number of days in specified year
'Copyright 2022 and later by Pongsathorn Sraouthai
If AthikaSurathin(iYear) = True Then
NODIYear = 366
Else
NODIYear = 365
End If
End Function
Public Function THLDate(iDate As Date, Optional ThaiNumber As Boolean = False, Optional ThaiZodiac As Integer = 0, Optional Era As Integer = 0, Optional ZOption As Boolean = False, Optional Holiday As Boolean = False, Optional DhammaDay As Boolean = False, Optional NumberOnly As Boolean = False, Optional MonthName As Boolean = False, Optional FullNumber As Boolean = False)
'THLDate = Thai Lunar Date สำหรับแสดงผลวันที่แบบจันทรคติไทย
'แปลงวันที่แบบสุริยคติให้เป็นจันทรคติ
'Copyright 2022 and later by Pongsathorn Sraouthai
'Version 2.0 Optimized for faster calculation
'Inspired by Loy's calculation
'ตัวแปร
'iDate = วันที่ ที่ใช้อ้างอิง
'ThaiNumber = ถ้าเป็น True แสดงผลเลขไทยแทนเลขอารบิก
'ThaiZodiac = 0 ไม่แสดงปีนักษัตร 1 แสดงชื่อปีนักษัตร 2 แสดงปีนักษัตรและศก
'Era = แสดงศักราช 0=ไม่แสดง 1=พุทธศักราช 2=จุลศักราช 3=มหาศักราช 4=รัตนโกสินทร์ศก 5=คริสตศักราช
'Zoption = ตัวเลือกสำหรับการแสดงชื่อปีนักษัตร: False = ใช้รูปแบบราชการ, True = ใช้รูปแบบโหราศาสตร์ไทย
'Holiday = ถ้าเป็น True แสดงชื่อวันสำคัญ
'DhammaDay = ถ้าเป็น True แสดงวันพระ
'NumberOnly = แสดงเป็นตัวเลขเท่านั้น โดยจะแสดงเป็นเลข 6 หลัก คือ 123456 12 = เป็น 10 ข้างขึ้น 00 ข้างแรม 34 = ค่ำ 56 = เดือน
'MonthName = ถ้าเป็น True แสดงชื่อเดือนแทนเลขเดือน
'FullNumber = เพิ่มตัวเลขอีก 5 หลักคือ 78901 78 = ปีนักษัตร เรียงตามเลข 01-12 01=ชวด 901 = จำนวนวันที่นับจาก 1 มกราคมของปีที่ระบุ
Dim DayInYear
Dim BeginDate As Date
Dim PrevYear, CurrYear
Dim i As Integer, j As Integer
Dim ThM, DofY, DofM, RDayPrev, DayOfYear, DayFromOne, NbLDayYear, ThS, ThZ, ThH, RDayLY, ThD1, ThD2, TmpD, ThK, TlS, CYr
Dim sDate(1 To 56) As Date, cYear
'ตรวจสอบว่าเป็นปีที่รองรับการคำนวณได้หรือไม่
If year(iDate) < 1903 Or year(iDate) > 2460 Then
THLDate = "ไม่รองรับ"
Exit Function
End If
'เลือก begin date ให้ใกล้สุดเพื่อที่จะได้ทำงานไวสุด
sDate(1) = DateSerial(1902, 11, 30)
sDate(2) = DateSerial(1912, 12, 8)
sDate(3) = DateSerial(1922, 11, 19)
sDate(4) = DateSerial(1932, 11, 27)
sDate(5) = DateSerial(1942, 12, 7)
sDate(6) = DateSerial(1952, 11, 16)
sDate(7) = DateSerial(1962, 11, 26)
sDate(8) = DateSerial(1972, 12, 5)
sDate(9) = DateSerial(1982, 11, 15)
sDate(10) = DateSerial(1992, 11, 24)
sDate(11) = DateSerial(2002, 12, 4)
sDate(12) = DateSerial(2012, 11, 13)
sDate(13) = DateSerial(2022, 11, 23)
sDate(14) = DateSerial(2032, 12, 2)
sDate(15) = DateSerial(2042, 12, 12)
sDate(16) = DateSerial(2052, 11, 21)
sDate(17) = DateSerial(2062, 12, 1)
sDate(18) = DateSerial(2072, 12, 9)
sDate(19) = DateSerial(2082, 11, 20)
sDate(20) = DateSerial(2092, 11, 28)
sDate(21) = DateSerial(2102, 12, 9)
sDate(22) = DateSerial(2112, 11, 18)
sDate(23) = DateSerial(2122, 11, 28)
sDate(24) = DateSerial(2132, 12, 7)
sDate(25) = DateSerial(2142, 11, 17)
sDate(26) = DateSerial(2152, 11, 26)
sDate(27) = DateSerial(2162, 12, 6)
sDate(28) = DateSerial(2172, 11, 15)
sDate(29) = DateSerial(2182, 11, 25)
sDate(30) = DateSerial(2192, 12, 4)
sDate(31) = DateSerial(2202, 12, 15)
sDate(32) = DateSerial(2212, 11, 24)
sDate(33) = DateSerial(2222, 12, 4)
sDate(34) = DateSerial(2232, 12, 12)
sDate(35) = DateSerial(2242, 11, 23)
sDate(36) = DateSerial(2252, 12, 1)
sDate(37) = DateSerial(2262, 12, 11)
sDate(38) = DateSerial(2272, 11, 20)
sDate(39) = DateSerial(2282, 11, 30)
sDate(40) = DateSerial(2292, 12, 9)
sDate(41) = DateSerial(2302, 11, 20)
sDate(42) = DateSerial(2312, 11, 29)
sDate(43) = DateSerial(2322, 12, 9)
sDate(44) = DateSerial(2332, 11, 18)
sDate(45) = DateSerial(2342, 11, 28)
sDate(46) = DateSerial(2352, 12, 7)
sDate(47) = DateSerial(2362, 12, 17)
sDate(48) = DateSerial(2372, 11, 26)
sDate(49) = DateSerial(2382, 12, 6)
sDate(50) = DateSerial(2392, 12, 14)
sDate(51) = DateSerial(2402, 11, 25)
sDate(52) = DateSerial(2412, 12, 3)
sDate(53) = DateSerial(2422, 12, 13)
sDate(54) = DateSerial(2432, 11, 23)
sDate(55) = DateSerial(2442, 12, 2)
sDate(56) = DateSerial(2452, 12, 11)
cYear = year(iDate) - 1
Select Case cYear
Case Is > 2452
BeginDate = sDate(56)
Case Is > 2442
BeginDate = sDate(55)
Case Is > 2432
BeginDate = sDate(54)
Case Is > 2422
BeginDate = sDate(53)
Case Is > 2412
BeginDate = sDate(52)
Case Is > 2402
BeginDate = sDate(51)
Case Is > 2392
BeginDate = sDate(50)
Case Is > 2382
BeginDate = sDate(49)
Case Is > 2372
BeginDate = sDate(48)
Case Is > 2362
BeginDate = sDate(47)
Case Is > 2352
BeginDate = sDate(46)
Case Is > 2342
BeginDate = sDate(45)
Case Is > 2332
BeginDate = sDate(44)
Case Is > 2322
BeginDate = sDate(43)
Case Is > 2312
BeginDate = sDate(42)
Case Is > 2302
BeginDate = sDate(41)
Case Is > 2292
BeginDate = sDate(40)
Case Is > 2282
BeginDate = sDate(39)
Case Is > 2272
BeginDate = sDate(38)
Case Is > 2262
BeginDate = sDate(37)
Case Is > 2252
BeginDate = sDate(36)
Case Is > 2242
BeginDate = sDate(35)
Case Is > 2232
BeginDate = sDate(34)
Case Is > 2222
BeginDate = sDate(33)
Case Is > 2212
BeginDate = sDate(32)
Case Is > 2202
BeginDate = sDate(31)
Case Is > 2192
BeginDate = sDate(30)
Case Is > 2182
BeginDate = sDate(29)
Case Is > 2172
BeginDate = sDate(28)
Case Is > 2162
BeginDate = sDate(27)
Case Is > 2152
BeginDate = sDate(26)
Case Is > 2142
BeginDate = sDate(25)
Case Is > 2132
BeginDate = sDate(24)
Case Is > 2122
BeginDate = sDate(23)
Case Is > 2112
BeginDate = sDate(22)
Case Is > 2102
BeginDate = sDate(21)
Case Is > 2092
BeginDate = sDate(20)
Case Is > 2082
BeginDate = sDate(19)
Case Is > 2072
BeginDate = sDate(18)
Case Is > 2062
BeginDate = sDate(17)
Case Is > 2052
BeginDate = sDate(16)
Case Is > 2042
BeginDate = sDate(15)
Case Is > 2032
BeginDate = sDate(14)
Case Is > 2022
BeginDate = sDate(13)
Case Is > 2012
BeginDate = sDate(12)
Case Is > 2002
BeginDate = sDate(11)
Case Is > 1992
BeginDate = sDate(10)
Case Is > 1982
BeginDate = sDate(9)
Case Is > 1972
BeginDate = sDate(8)
Case Is > 1962
BeginDate = sDate(7)
Case Is > 1952
BeginDate = sDate(6)
Case Is > 1942
BeginDate = sDate(5)
Case Is > 1932
BeginDate = sDate(4)
Case Is > 1922
BeginDate = sDate(3)
Case Is > 1912
BeginDate = sDate(2)
Case Is > 1902
BeginDate = sDate(1)
End Select
'นับวารถึงปีก่อนหน้าปีปัจจุบัน
For i = year(BeginDate) + 1 To year(iDate) - 1
DayInYear = LDayInYear(i)
PrevYear = DateAdd("d", DayInYear, BeginDate)
BeginDate = PrevYear
Next i
RDayPrev = DateDiff("d", PrevYear, DateSerial(year(PrevYear), 12, 31)) 'จำนวนวารที่เหลืออยู่ของปี นับจาก ขึ้น 1 ค่ำเดือน 1
DayOfYear = DateDiff("d", DateSerial(year(iDate), 1, 1), iDate) 'จำนวนวันของปีที่ถึงวันที่ที่กำหนด
DayFromOne = RDayPrev + DayOfYear + 1 'จำนวนวารจากขึ้น ๑ ค่ำ เดือน ๑ + จำนวนวารที่เหลือในปีถัดไป
NbLDayYear = LDayInYear(year(iDate)) 'จำนวนวารของปี
'จำแนกชนิดของปีปัจจุบัน
Select Case NbLDayYear
Case 354 'ปีปกติ
RDayLY = RDayPrev + NODIYear(year(iDate))
DofY = DayFromOne
For j = 1 To 14
ThM = j
Select Case j
Case 1
If DofY <= 29 And DofY > 0 Then Exit For Else DofY = DofY - 29
Case 2
If DofY <= 30 And DofY > 0 Then Exit For Else DofY = DofY - 30
Case 3
If DofY <= 29 And DofY > 0 Then Exit For Else DofY = DofY - 29
Case 4
If DofY <= 30 And DofY > 0 Then Exit For Else DofY = DofY - 30
Case 5
If DofY <= 29 And DofY > 0 Then Exit For Else DofY = DofY - 29
Case 6
If DofY <= 30 And DofY > 0 Then Exit For Else DofY = DofY - 30
Case 7
If DofY <= 29 And DofY > 0 Then Exit For Else DofY = DofY - 29
Case 8
If DofY <= 30 And DofY > 0 Then Exit For Else DofY = DofY - 30
Case 9
If DofY <= 29 And DofY > 0 Then Exit For Else DofY = DofY - 29
Case 10
If DofY <= 30 And DofY > 0 Then Exit For Else DofY = DofY - 30
Case 11
If DofY <= 29 And DofY > 0 Then Exit For Else DofY = DofY - 29
Case 12
If DofY <= 30 And DofY > 0 Then Exit For Else DofY = DofY - 30
Case 13
If DofY <= 29 And DofY > 0 Then Exit For Else DofY = DofY - 29
Case 14
If DofY <= 30 And DofY > 0 Then Exit For Else DofY = DofY - 30
Case Else
End Select
Next
'ช่วงขึ้นปีใหม่ของราชการ
If ThM > 12 Then
ThM = ThM - 12
ThZ = 1
Else
ThZ = 0
End If
If NumberOnly = True Then
If DofY > 15 Then
ThS = "-"
DofY = DofY - 15
Else
ThS = "+"
End If
THLDate = ThS & Format(DofY, "00") & Format(ThM, "00")
'THLDate = ThS & DofY & " ค่ำ เดือน " & ThM
ElseIf MonthName = True Then
If DofY > 15 Then
ThS = "แรม "
DofY = DofY - 15
Else
ThS = "ขึ้น "
End If
THLDate = ThS & DofY & " ค่ำ " & THLMonth(CInt(ThM), year(iDate))
Else
If DofY > 15 Then
ThS = "แรม "
DofY = DofY - 15
Else
ThS = "ขึ้น "
End If
THLDate = ThS & DofY & " ค่ำ เดือน " & ThM
End If
Case 355 'ปีอธิกวาร
RDayLY = RDayPrev + NODIYear(year(iDate))
DofY = DayFromOne
For j = 1 To 14
ThM = j
Select Case j
Case 1
If DofY <= 29 And DofY > 0 Then Exit For Else DofY = DofY - 29
Case 2
If DofY <= 30 And DofY > 0 Then Exit For Else DofY = DofY - 30
Case 3
If DofY <= 29 And DofY > 0 Then Exit For Else DofY = DofY - 29
Case 4
If DofY <= 30 And DofY > 0 Then Exit For Else DofY = DofY - 30
Case 5
If DofY <= 29 And DofY > 0 Then Exit For Else DofY = DofY - 29
Case 6
If DofY <= 30 And DofY > 0 Then Exit For Else DofY = DofY - 30
Case 7
If DofY <= 30 And DofY > 0 Then Exit For Else DofY = DofY - 30
Case 8
If DofY <= 30 And DofY > 0 Then Exit For Else DofY = DofY - 30
Case 9
If DofY <= 29 And DofY > 0 Then Exit For Else DofY = DofY - 29
Case 10
If DofY <= 30 And DofY > 0 Then Exit For Else DofY = DofY - 30
Case 11
If DofY <= 29 And DofY > 0 Then Exit For Else DofY = DofY - 29
Case 12
If DofY <= 30 And DofY > 0 Then Exit For Else DofY = DofY - 30
Case 13
If DofY <= 29 And DofY > 0 Then Exit For Else DofY = DofY - 29
Case 14
If DofY <= 30 And DofY > 0 Then Exit For Else DofY = DofY - 30
Case Else
End Select
Next
If ThM > 12 Then
ThM = ThM - 12
ThZ = 1
Else
ThZ = 0
End If
If NumberOnly = True Then
If DofY > 15 Then
ThS = "-"
DofY = DofY - 15
Else
ThS = "+"
End If
THLDate = ThS & Format(DofY, "00") & Format(ThM, "00")
'THLDate = ThS & DofY & " ค่ำ เดือน " & ThM
ElseIf MonthName = True Then
If DofY > 15 Then
ThS = "แรม "
DofY = DofY - 15
Else
ThS = "ขึ้น "
End If
THLDate = ThS & DofY & " ค่ำ " & THLMonth(CInt(ThM), year(iDate))
Else
If DofY > 15 Then
ThS = "แรม "
DofY = DofY - 15
Else
ThS = "ขึ้น "
End If
THLDate = ThS & DofY & " ค่ำ เดือน " & ThM
End If
Case 384 'ปีอธิกมาส
RDayLY = RDayPrev + NODIYear(year(iDate))
DofY = DayFromOne
For j = 1 To 15
ThM = j
Select Case j
Case 1
If DofY <= 29 And DofY > 0 Then Exit For Else DofY = DofY - 29
Case 2
If DofY <= 30 And DofY > 0 Then Exit For Else DofY = DofY - 30
Case 3
If DofY <= 29 And DofY > 0 Then Exit For Else DofY = DofY - 29
Case 4
If DofY <= 30 And DofY > 0 Then Exit For Else DofY = DofY - 30
Case 5
If DofY <= 29 And DofY > 0 Then Exit For Else DofY = DofY - 29
Case 6
If DofY <= 30 And DofY > 0 Then Exit For Else DofY = DofY - 30
Case 7
If DofY <= 29 And DofY > 0 Then Exit For Else DofY = DofY - 29
Case 8
If DofY <= 30 And DofY > 0 Then Exit For Else DofY = DofY - 30
Case 9
If DofY <= 30 And DofY > 0 Then Exit For Else DofY = DofY - 30
Case 10
If DofY <= 29 And DofY > 0 Then Exit For Else DofY = DofY - 29
Case 11
If DofY <= 30 And DofY > 0 Then Exit For Else DofY = DofY - 30
Case 12
If DofY <= 29 And DofY > 0 Then Exit For Else DofY = DofY - 29
Case 13
If DofY <= 30 And DofY > 0 Then Exit For Else DofY = DofY - 30
Case 14
If DofY <= 29 And DofY > 0 Then Exit For Else DofY = DofY - 29
Case 15
If DofY <= 30 And DofY > 0 Then Exit For Else DofY = DofY - 30
Case Else
End Select
Next
If ThM > 13 Then
ThM = ThM - 13
ThZ = 1
Else
ThZ = 0
End If
Select Case ThM
Case 9
ThM = 88
Case 10
ThM = 9
Case 11
ThM = 10
Case 12
ThM = 11
Case 13
ThM = 12
End Select
If NumberOnly = True Then
If DofY > 15 Then
ThS = "-"
DofY = DofY - 15
Else
ThS = "+"
End If
THLDate = ThS & Format(DofY, "00") & Format(ThM, "00")
'THLDate = ThS & DofY & " ค่ำ เดือน " & ThM
ElseIf MonthName = True Then
If DofY > 15 Then
ThS = "แรม "
DofY = DofY - 15
Else
ThS = "ขึ้น "
End If
THLDate = ThS & DofY & " ค่ำ " & THLMonth(CInt(ThM), year(iDate))
Else
If DofY > 15 Then
ThS = "แรม "
DofY = DofY - 15
Else
ThS = "ขึ้น "
End If
THLDate = ThS & DofY & " ค่ำ เดือน " & ThM
End If
End Select
'เปิดใช้เลขไทย ถ้าตัวเลือก ThaiNumber เป็น True
If ThaiNumber = True Then THLDate = W2TH(CStr(THLDate))
'แสดงปีนักษัตร ตามระบบราชการ ถ้าตัวเลือก ThaiZodiac เป็น True
If ThaiZodiac > 0 Then
Select Case ThaiZodiac
Case 1
If ZOption = False Then
If ThZ = 1 Then
THLDate = THLDate & " ปี" & ThZodiac(year(iDate) + 1)
Else
THLDate = THLDate & " ปี" & ThZodiac(year(iDate))
End If
Else
ThH = ThM
If ThH < 5 And ThZ = 0 Then
THLDate = THLDate & " ปี" & ThZodiac(year(iDate) - 1)
ElseIf ThH < 5 And ThZ = 1 Then
THLDate = THLDate & " ปี" & ThZodiac(year(iDate))
Else
THLDate = THLDate & " ปี" & ThZodiac(year(iDate))
End If
End If
Case 2
TlS = DateSerial(year(iDate), 4, ThLSokDay(year(iDate), 1))
If iDate < TlS Then CYr = ThSok(year(iDate) - 1) Else CYr = ThSok(year(iDate))
If ZOption = False Then
If ThZ = 1 Then
THLDate = THLDate & " ปี" & ThZodiac(year(iDate) + 1) & " " & CYr
Else
THLDate = THLDate & " ปี" & ThZodiac(year(iDate)) & " " & CYr
End If
Else
ThH = ThM
If ThH < 5 And ThZ = 0 Then
THLDate = THLDate & " ปี" & ThZodiac(year(iDate) - 1) & " " & CYr
ElseIf ThH < 5 And ThZ = 1 Then
THLDate = THLDate & " ปี" & ThZodiac(year(iDate)) & " " & CYr
Else
THLDate = THLDate & " ปี" & ThZodiac(year(iDate)) & " " & CYr
End If
End If
End Select
End If
'แสดงปีศักราช ถ้าตัวเลือก Era เป็น 1-5
Select Case Era
Case 1
Select Case ThaiNumber
Case True
THLDate = W2TH(THLDate & " พุทธศักราช " & year(iDate) + 543)
Case False
THLDate = THLDate & " พุทธศักราช " & year(iDate) + 543
End Select
Case 2
TlS = DateSerial(year(iDate), 4, ThLSokDay(year(iDate), 1))
If iDate < TlS Then CYr = year(iDate) - 639 Else CYr = year(iDate) - 638
Select Case ThaiNumber
Case True
THLDate = W2TH(THLDate & " จุลศักราช " & CYr)
Case False
THLDate = THLDate & " จุลศักราช " & CYr
End Select
Case 3
Select Case ThaiNumber
Case True
THLDate = W2TH(THLDate & " มหาศักราช " & year(iDate) - 78)
Case False
THLDate = THLDate & " มหาศักราช " & year(iDate) - 78
End Select
Case 4
Select Case ThaiNumber
Case True
THLDate = W2TH(THLDate & " รัตนโกสินทร์ศก " & year(iDate) - 1781)
Case False
THLDate = THLDate & " รัตนโกสินทร์ศก " & year(iDate) - 1781
End Select
Case 5
Select Case ThaiNumber
Case True
THLDate = W2TH(THLDate & " คริสตศักราช " & year(iDate))
Case False
THLDate = THLDate & " คริสตศักราช " & year(iDate)
End Select
Case Else
End Select
If Holiday = True Then
THLDate = THLDate & " " & ThLunarHoliday(iDate)
End If
'แสดงตวงจันทร์ในวันพระ
If DhammaDay = True Then
THLDate = THLDate & thDmDay(iDate)
End If
If NumberOnly = True Then
'แสดงข้อมูลในลักษณะตัวเลข
'000000
'^^ 10 = ข้างขึ้น 00 = ข้างแรม
' ^^ = ค่ำ
' ^^ = เดือน
THLDate = Replace(THLDate, "+", "10")
THLDate = Replace(THLDate, "-", "00")
If FullNumber = True Then
'เพิ่มตัวเลขปีกับเลขจำนวนวันของปีนั้นๆ
'00000
'^^ ปีนักษัตร 01-12
' ^^^ จำนวนวันของปี 000-365
If ThZ = 1 Then
THLDate = THLDate & Format(ThZodiac(year(iDate) + 1, 3), "00")
THLDate = THLDate & Format(DayOfYear, "000")
Else
THLDate = THLDate & Format(ThZodiac(year(iDate), 3), "00")
THLDate = THLDate & Format(DayOfYear, "000")
End If
End If
End If
THLDate = Trim(THLDate)
End Function
Public Function ThZodiac(iYear As Integer, Optional OType As Integer = 1)
'สำหรับใช้ระบุปีนักษัตร
'ThZodiac = Thai Zodiac Year Name
'Return Zodiac Name of specified Year
'Copyright 2022 and later by Pongsathorn Sraouthai
'
'oType = Output Type
'1 = Thai
'2 = English
'3 = Number
'4 = Picture
'5 = Sok
Dim Zodiac(1 To 4, 1 To 12)
Dim Result
Zodiac(1, 1) = "ชวด"
Zodiac(1, 2) = "ฉลู"
Zodiac(1, 3) = "ขาล"
Zodiac(1, 4) = "เถาะ"
Zodiac(1, 5) = "มะโรง"
Zodiac(1, 6) = "มะเส็ง"
Zodiac(1, 7) = "มะเมีย"
Zodiac(1, 8) = "มะแม"
Zodiac(1, 9) = "วอก"
Zodiac(1, 10) = "ระกา"
Zodiac(1, 11) = "จอ"
Zodiac(1, 12) = "กุน"
Zodiac(2, 1) = "RAT"
Zodiac(2, 2) = "OX"
Zodiac(2, 3) = "TIGER"
Zodiac(2, 4) = "RABBIT"
Zodiac(2, 5) = "NAGA"
Zodiac(2, 6) = "SNAKE"
Zodiac(2, 7) = "HORSE"
Zodiac(2, 8) = "GOAT"
Zodiac(2, 9) = "MONKEY"
Zodiac(2, 10) = "ROOSTER"
Zodiac(2, 11) = "DOG"
Zodiac(2, 12) = "PIG"
Zodiac(3, 1) = 1
Zodiac(3, 2) = 2
Zodiac(3, 3) = 3
Zodiac(3, 4) = 4
Zodiac(3, 5) = 5
Zodiac(3, 6) = 6
Zodiac(3, 7) = 7
Zodiac(3, 8) = 8
Zodiac(3, 9) = 9
Zodiac(3, 10) = 10
Zodiac(3, 11) = 11
Zodiac(3, 12) = 12
Zodiac(4, 1) = U2W("-10179 -9171")
Zodiac(4, 2) = U2W("-10179 -9170")
Zodiac(4, 3) = U2W("-10179 -9169")
Zodiac(4, 4) = U2W("-10179 -9168")
Zodiac(4, 5) = U2W("-10179 -9166")
Zodiac(4, 6) = U2W("-10179 -9203")
Zodiac(4, 7) = U2W("-10179 -9164")
Zodiac(4, 8) = U2W("-10179 -9200")
Zodiac(4, 9) = U2W("-10179 -9163")
Zodiac(4, 10) = U2W("-10179 -9196")
Zodiac(4, 11) = U2W("-10179 -9162")
Zodiac(4, 12) = U2W("-10179 -9161")
Result = iYear Mod 12
If Result - 3 < 1 Then
Result = Result - 3 + 12
Else
Result = Result - 3
End If
If OType = 5 Then
ThZodiac = Zodiac(1, Result) & ThSok(iYear)
Else
ThZodiac = Zodiac(OType, Result)
End If
End Function
Public Function ThLunarHoliday(iDate As Date, Optional FromCell As Boolean = False) As String
'สำหรับแสดงผลวันสำคัญทางจันทรคติ
'
'จำเป็นต้องใช้ฟังชั่น Athikamas และ THLDate
If AthikaMas(year(iDate)) = False Then
Select Case THLDate(iDate)
Case "ขึ้น 15 ค่ำ เดือน 3"
ThLunarHoliday = "วันมาฆบูชา"
Case "ขึ้น 15 ค่ำ เดือน 6"
ThLunarHoliday = "วันวิสาขบูชา"
Case "แรม 8 ค่ำ เดือน 6"
ThLunarHoliday = "วันอัฏฐมีบูชา"
Case "ขึ้น 15 ค่ำ เดือน 8"
ThLunarHoliday = "วันอาสาฬหบูชา"
Case "แรม 1 ค่ำ เดือน 8"
ThLunarHoliday = "วันเข้าพรรษา"
Case "แรม 15 ค่ำ เดือน 10"
ThLunarHoliday = "วันสารท"
Case "ขึ้น 15 ค่ำ เดือน 11"
ThLunarHoliday = "วันออกพรรษา"
Case "ขึ้น 15 ค่ำ เดือน 12"
ThLunarHoliday = "วันลอยกระทง"
Case Else
If FromCell = True Then
ThLunarHoliday = "ไม่ใช่วันสำคัญทางจันทรคติ"
Else
ThLunarHoliday = ""
End If
End Select
Else
Select Case THLDate(iDate)
Case "ขึ้น 15 ค่ำ เดือน 4"
ThLunarHoliday = "วันมาฆบูชา"
Case "ขึ้น 15 ค่ำ เดือน 7"
ThLunarHoliday = "วันวิสาขบูชา"
Case "แรม 8 ค่ำ เดือน 7"
ThLunarHoliday = "วันอัฏฐมีบูชา"
Case "ขึ้น 15 ค่ำ เดือน 88"
ThLunarHoliday = "วันอาสาฬหบูชา"
Case "แรม 1 ค่ำ เดือน 88"
ThLunarHoliday = "วันเข้าพรรษา"
Case "แรม 15 ค่ำ เดือน 10"
ThLunarHoliday = "วันสารท"
Case "ขึ้น 15 ค่ำ เดือน 11"
ThLunarHoliday = "วันออกพรรษา"
Case "ขึ้น 15 ค่ำ เดือน 12"
ThLunarHoliday = "วันลอยกระทง"
Case Else
If FromCell = True Then
ThLunarHoliday = "ไม่ใช่วันสำคัญทางจันทรคติ"
Else
ThLunarHoliday = ""
End If
End Select
End If
End Function
Public Function ThHonThai(iNumber As Integer, Optional OType As String = "y")
'สำหรับแสดงปีแบบหนไท
'oType y = สำหรับใช้กับปี (ค.ศ.) d = สำหรับใช้กับวัน
Dim mY(1 To 10), sY(1 To 12)
Dim Result, r1, r2, d1, d2, Result2
mY(1) = "กาบ" '6
mY(2) = "ดับ" '7
mY(3) = "รวาย" '8
mY(4) = "เมือง" '9
mY(5) = "เปิก" '10
mY(6) = "กัด" '1
mY(7) = "กด" '2
mY(8) = "ร้วง" '3
mY(9) = "เต่า" '4
mY(10) = "ก่า" '5
sY(1) = "ใจ้" '2
sY(2) = "เป้า" '3
sY(3) = "ยี" '4
sY(4) = "เหม้า" '5
sY(5) = "สี" '6
sY(6) = "ใส้" '7
sY(7) = "สะง้า" '8
sY(8) = "เม็ด" '9
sY(9) = "สัน" '10
sY(10) = "เร้า" '11
sY(11) = "เส็ด" '12
sY(12) = "ใค้" '1
r1 = XLMod(iNumber, 10)
If r1 - 3 < 1 Then
r1 = r1 - 3 + 10
Else
r1 = r1 - 3
End If
r2 = XLMod(iNumber, 12)
If r2 - 3 < 1 Then
r2 = r2 - 3 + 12
Else
r2 = r2 - 3
End If
Result = mY(r1) & sY(r2)
d1 = XLMod(iNumber, 10)
If d1 = 0 Then d1 = 10
d2 = XLMod(iNumber, 12)
If d2 = 0 Then d2 = 12
Result2 = mY(d1) & sY(d2)
Select Case OType
Case "d", "D"
ThHonThai = Result2
Case "y", "Y"
ThHonThai = Result
End Select
End Function
Public Function ThSok(iYear As Integer)
'แสดงชื่อศกตามแบบอยุธยา (ตามจุลศักราช)
Dim mY(1 To 10)
Dim Result
mY(1) = "ฉศก"
mY(2) = "สัปตศก"
mY(3) = "อัษฏศก"
mY(4) = "นพศก"
mY(5) = "สัมฤทธิศก"
mY(6) = "เอกศก"
mY(7) = "โทศก"
mY(8) = "ตรีศก"
mY(9) = "จัตวาศก"
mY(10) = "เบญจศก"
Result = iYear Mod 10
If Result - 3 < 1 Then
Result = Result - 3 + 10
Else
Result = Result - 3
End If
ThSok = mY(Result)
End Function
Public Function ThKalaYoga(iYear As Integer, Optional OType As Integer = 1, Optional TOutput As Integer = 1, Optional CheckYear As Boolean = False)
'กาลโยค
'oType: 1=แสดงตามแถว 2=แสดงในช่องเดียว(หลายแถว 3=แสดงในช่องเดียว แถวเดียว 4=แสดงในหลายช่อง แถวเดียว)
'tOutput: 1 วัน, 2 ยาม, 3 ฤกษ์บน, 4 ฤกษ์ล่าง, 5 ราศี, 6 ดิถี
'CheckYear: True ตรวจสอบวันที่ปัจจุบันว่าเลยวันเถลิงศกหรือไม่ ถ้าเลยวันเถลิงศกแล้ว ถึงจะแสดงข้อมูลปีที่ระบุ หากไม่เลยจะแสดงข้อมูลปีก่อนหน้า False ไม่ตรวจสอบ
Dim JYear, d1, d2, d3, d4, Result, dayn(1 To 7), TOut, JDate, CurrDate
dayn(1) = "อาทิตย์"
dayn(2) = "จันทร์"
dayn(3) = "อังคาร"
dayn(4) = "พุธ"
dayn(5) = "พฤหัสบดี"
dayn(6) = "ศุกร์"
dayn(7) = "เสาร์"
'ตรวจสอบวันที่ปัจจุบันเทียบกับวันเกลิงศก
If CheckYear = True Then
CurrDate = DateSerial(iYear, month(Date), day(Date))
JDate = ThLSokDay(iYear, 2)
If CurrDate <= JDate Then
JYear = iYear - 639
Else
JYear = iYear - 638 'แปลงเป็นจุลศักราช
End If
Else
JYear = iYear - 638 'แปลงเป็นจุลศักราช
End If
Select Case TOutput
Case 1
'วัน
TOut = "วัน"
'ธงชัย
d1 = XLMod(JYear * 10 + 3, 7)
If d1 = 0 Then d1 = 7
'อธิบดี
d2 = XLMod(XLMod(JYear, 498), 7)
If d2 = 0 Then d2 = 7
'อุบาทว์
d3 = XLMod(JYear * 10 + 2, 7)
If d3 = 0 Then d3 = 7
'โลกาวินาศ
d4 = XLMod(JYear + 1120, 7)
If d4 = 0 Then d4 = 7
Result = Array(dayn(d1) & " ธงชัย", dayn(d2) & " อธิบดี", dayn(d3) & " อุบาทว์", dayn(d4) & " โลกาวินาศ")
Case 2
'ยาม
TOut = "ยาม"
'ธงชัย
d1 = XLMod(JYear * 10 + 3, 8)
If d1 = 0 Then d1 = 8
'อธิบดี
d2 = XLMod(XLMod(JYear, 498), 8)
If d2 = 0 Then d2 = 8
'อุบาทว์
d3 = XLMod(JYear * 10 + 2, 8)
If d3 = 0 Then d3 = 8
'โลกาวินาศ
d4 = XLMod(JYear + 1120, 8)
If d4 = 0 Then d4 = 8
Result = Array(d1 & " ธงชัย", d2 & " อธิบดี", d3 & " อุบาทว์", d4 & " โลกาวินาศ")
Case 3
'ฤกษ์บน
TOut = "ฤกษ์บน"
'ธงชัย
d1 = XLMod(JYear * 10 + 3, 27)
If d1 = 0 Then d1 = 27
'อธิบดี
d2 = XLMod(XLMod(JYear, 498), 27)
If d2 = 0 Then d2 = 27
'อุบาทว์
d3 = XLMod(JYear * 10 + 2, 27)
If d3 = 0 Then d3 = 27
'โลกาวินาศ
d4 = XLMod(JYear + 1120, 27)
If d4 = 0 Then d4 = 27
Result = Array(d1 & " ธงชัย", d2 & " อธิบดี", d3 & " อุบาทว์", d4 & " โลกาวินาศ")
Case 4
'ฤกษ์ล่าง
TOut = "ฤกษ์ล่าง"
'ธงชัย
d1 = XLMod(JYear * 10 + 3, 9)
If d1 = 0 Then d1 = 9
'อธิบดี
d2 = XLMod(XLMod(JYear, 498), 9)
If d2 = 0 Then d2 = 9
'อุบาทว์
d3 = XLMod(JYear * 10 + 2, 9)
If d3 = 0 Then d3 = 9
'โลกาวินาศ
d4 = XLMod(JYear + 1120, 9)
If d4 = 0 Then d4 = 9
Result = Array(d1 & " ธงชัย", d2 & " อธิบดี", d3 & " อุบาทว์", d4 & " โลกาวินาศ")
Case 5
'ราศี
TOut = "ราศี"
'ธงชัย
d1 = XLMod(JYear * 10 + 3, 12)
If d1 = 0 Then d1 = 12
'อธิบดี
d2 = XLMod(XLMod(JYear, 498), 12)
If d2 = 0 Then d2 = 12
'อุบาทว์
d3 = XLMod(JYear * 10 + 2, 12)
If d3 = 0 Then d3 = 12
'โลกาวินาศ
d4 = XLMod(JYear + 1120, 12)
If d4 = 0 Then d4 = 12
Result = Array(d1 & " ธงชัย", d2 & " อธิบดี", d3 & " อุบาทว์", d4 & " โลกาวินาศ")
Case 6
'ดิถี
TOut = "ดิถี"
'ธงชัย
d1 = XLMod(JYear * 10 + 3, 30)
If d1 = 0 Then d1 = 30
'อธิบดี
d2 = XLMod(XLMod(JYear, 498), 30)
If d2 = 0 Then d2 = 30
'อุบาทว์
d3 = XLMod(JYear * 10 + 2, 30)
If d3 = 0 Then d3 = 30
'โลกาวินาศ
d4 = XLMod(JYear + 1120, 30)
If d4 = 0 Then d4 = 30
Result = Array(d1 & " ธงชัย", d2 & " อธิบดี", d3 & " อุบาทว์", d4 & " โลกาวินาศ")
Case Else
ThKalaYoga = "ไม่รองรับ"
End Select
Select Case OType
Case 1
ThKalaYoga = Application.Transpose(Result)
Case 2
ThKalaYoga = TOut & " " & d1 & " ธงชัย" & Chr(10) & d2 & " อธิบดี" & Chr(10) & d3 & " อุบาทว์" & Chr(10) & d4 & " โลกาวินาศ"
With ActiveCell
.WrapText = True
.Columns.AutoFit
.Rows.AutoFit
End With
Case 3
ThKalaYoga = TOut & " " & d1 & " ธงชัย" & " " & d2 & " อธิบดี" & " " & d3 & " อุบาทว์" & " " & d4 & " โลกาวินาศ"
Case 4
ThKalaYoga = Result
Case Else
ThKalaYoga = "#N/A"
End Select
End Function
Function thDmDay(iDate As Date)
'สำหรับแสดงวันพระ
'7446 ขึ้น 8
'7447 แรม 8
'9675 ขึ้น15
'9679 แรม14-15
'9784 ธรรมจักร
Dim nDate, n1, n2, n3
nDate = THLDate(iDate, , , , , , , True)
n1 = Mid(nDate, 1, 1)
n2 = Mid(nDate, 3, 2)
n3 = Mid(nDate, 5, 2)
Select Case n1
Case "1"
Select Case n2
Case "08"
thDmDay = ChrW(9784)
Case "15"
thDmDay = ChrW(9784)
Case Else
thDmDay = ""
End Select
Case "0"
Select Case n2
Case "08"
thDmDay = ChrW(9784)
Case "14"
Select Case LDayInYear(year(iDate))
Case 354
If val(n3) Mod 2 = 1 Then thDmDay = ChrW(9784) Else thDmDay = ""
Case 355
If val(n3) Mod 2 = 1 And val(n3) <> 7 Then thDmDay = ChrW(9784) Else thDmDay = ""
Case 384
If val(n3) Mod 2 = 1 Then thDmDay = ChrW(9784) Else thDmDay = ""
End Select
Case "15"
thDmDay = ChrW(9784)
Case Else
thDmDay = ""
End Select
End Select
End Function
Public Function thDithi(iDate As Date, Optional AsRow As Boolean = False, Optional AsOne As Boolean = False, Optional AsSep As Integer = 0)
'ดิถีฤกษ์
Dim wkDay, lDay, slDay, sDay, lMon, dt(22), dt1, dt2, i As Long, Result, Dt01, Dt02, Dt03, Dt04, Dt05, Dt06
'อำมฤคโชค
Dim Amma As Variant
'สิทธิโชค
Dim Sitt As Variant
'มหาสิทธิโชค
Dim Maha As Variant
'ราชาโชค
Dim Raja As Variant
'ชัยโชค
Dim Chai As Variant
'ทักทิน
Dim Takt As Variant
'ทรทึก
Dim Tora As Variant
'ยมขันธ์
Dim Yomk As Variant
'ทัคธทิน
Dim Thak As Variant
'อัคนิโรธ
Dim Akni As Variant
'ทินกาล
Dim Tink As Variant
'ทินสูร
Dim Tins As Variant
'กาลโชค
Dim Kalc As Variant
'กาลสูร
Dim Kals As Variant
'กาลทัณฑ์
Dim Kalta As Variant
'โลกาวินาศ
Dim Loka As Variant
'วินาศ
Dim Vina As Variant
'พิลา
Dim Pila As Variant
'มฤตยู
Dim Mari As Variant
'วันบอด
Dim Blin As Variant
'กาลทิน
Dim Kalti As Variant
'พิฆาต
Dim Pika As Variant
'พระกาล
Dim Prak As Variant
'เรียงหมอน
Dim Morn(2, 15)
'หว่านข้าว
Dim Waan(2, 15)
'รับเลี้ยง
Dim Liang(2, 15)
'เดินทาง
Dim Trav(15)
'มหาสูญ
Dim SupLoss(12)
'Good
Amma = Array(8, 3, 9, 2, 4, 1, 5)
Sitt = Array(11, 5, 14, 10, 9, 11, 4)
Maha = Array(14, 12, 13, 4, 7, 10, 15)
Raja = Array(6, 3, 9, 6, 10, 1, 5)
Chai = Array(8, 3, 11, 10, 4, 1, 11)
'Bad
Takt = Array(1, 4, 6, 9, 5, 3, 7)
Tora = Array(4, 6, 1, 3, 8, 7, 1)
Yomk = Array(12, 11, 7, 3, 6, 8, 9)
Takt = Array(12, 11, 10, 7, 8, 7, 6)
Akni = Array(4, 6, 1, 3, 3, 9, 1)
Tink = Array(1, 2, 10, 7, 1, 6, 6)
Tins = Array(12, 10, 15, 8, 5, 7, 8)
Kalc = Array(4, 6, 1, 3, 8, 9, 10)
Kals = Array(4, 2, 7, 5, 8, 3, 6)
Kalta = Array(12, 11, 10, 9, 8, 7, 6)
Loka = Array(4, 6, 10, 9, 8, 9, 1)
Vina = Array(4, 5, 6, 6, 8, 8, 9)
Pila = Array(6, 10, 8, 7, 12, 9, 12)
Mari = Array(9, 1, 10, 9, 8, 7, 6)
Blin = Array(7, 8, 4, 7, 1, 14, 11)
Kalti = Array(5, 6, 10, 8, 10, 5, 7)
Pika = Array(12, 11, 7, 3, 6, 9, 8)
Prak = Array(2, 11, 7, 5, 6, 9, 8)
'another
Morn(1, 1) = "หัวสบขาขึ้น"
Morn(1, 2) = "หัวสบขาลง"
Morn(1, 3) = "หัวชนกัน"
Morn(1, 4) = "หัวชนกัน"
Morn(1, 5) = "เรียงหมอนหัวลง"
Morn(1, 6) = "เรียงหมอนหัวลง"
Morn(1, 7) = "เรียงหมอนหัวขึ้น"
Morn(1, 8) = "หัวชนกัน"
Morn(1, 9) = "หัวชนกัน"
Morn(1, 10) = "เรียงหมอนหัวขึ้น"
Morn(1, 11) = "หัวสบขาขึ้น"
Morn(1, 12) = "เรียงหมอนหัวลง"
Morn(1, 13) = "เรียงหมอนหัวขึ้น"
Morn(1, 14) = "หัวชนกัน"
Morn(1, 15) = "หัวสบขาขึ้น"
Morn(2, 1) = "หัวชนกัน"
Morn(2, 2) = "เรียงหมอนหัวลง"
Morn(2, 3) = "เท้ายันกัน"
Morn(2, 4) = "เรียงหมอนหัวขึ้น"
Morn(2, 5) = "หัวชนกัน"
Morn(2, 6) = "เท้ายันกัน"
Morn(2, 7) = "หัวสบขาขึ้น"
Morn(2, 8) = "เรียงหมอนหัวขึ้น"
Morn(2, 9) = "หัวสบขาขึ้น"
Morn(2, 10) = "เรียงหมอนหัวขึ้น"
Morn(2, 11) = "หัวชนกัน"
Morn(2, 12) = "หัวชนกัน"
Morn(2, 13) = "หัวชนกัน"
Morn(2, 14) = "เรียงหมอนหัวขึ้น"
Morn(2, 15) = "หัวชนกัน"
Waan(1, 1) = "รวงน้อย" & ChrW(&H2591)
Waan(1, 2) = "รวงน้อย" & ChrW(&H2591)
Waan(1, 3) = "รวงน้อย" & ChrW(&H2591)
Waan(1, 4) = "รวงปานกลาง" & ChrW(&H2592)
Waan(1, 5) = "รวงปานกลาง" & ChrW(&H2592)
Waan(1, 6) = "รวงมาก" & ChrW(&H2593)
Waan(1, 7) = "รวงมาก" & ChrW(&H2593)
Waan(1, 8) = "รวงมาก" & ChrW(&H2593)
Waan(1, 9) = "รวงปานกลาง" & ChrW(&H2592)
Waan(1, 10) = "ไม่มีรวง" & ChrW(&H2502)
Waan(1, 11) = "ไม่มีรวง" & ChrW(&H2502)
Waan(1, 12) = "รวงมาก" & ChrW(&H2593)
Waan(1, 13) = "รวงมาก" & ChrW(&H2593)
Waan(1, 14) = "รวงมาก" & ChrW(&H2593)
Waan(1, 15) = "รวงมาก" & ChrW(&H2593)
Waan(2, 1) = "รวงมาก" & ChrW(&H2593)
Waan(2, 2) = "ไม่มีรวง" & ChrW(&H2502)
Waan(2, 3) = "ไม่มีรวง" & ChrW(&H2502)
Waan(2, 4) = "ไม่มีรวง" & ChrW(&H2502)
Waan(2, 5) = "ไม่มีรวง" & ChrW(&H2502)
Waan(2, 6) = "ไม่มีรวง" & ChrW(&H2502)
Waan(2, 7) = "รวงมาก" & ChrW(&H2593)
Waan(2, 8) = "รวงปานกลาง" & ChrW(&H2592)
Waan(2, 9) = "ไม่มีรวง" & ChrW(&H2502)
Waan(2, 10) = "ไม่มีรวง" & ChrW(&H2502)
Waan(2, 11) = "ไม่มีรวง" & ChrW(&H2502)
Waan(2, 12) = "ไม่มีรวง" & ChrW(&H2502)
Waan(2, 13) = "รวงมาก" & ChrW(&H2593)
Waan(2, 14) = "ไม่มีรวง" & ChrW(&H2502)
Waan(2, 15) = "รวงน้อย" & ChrW(&H2591)
Liang(1, 1) = "ผีกินผี"
Liang(1, 2) = "ผีกินคน"
Liang(1, 3) = "ผีกินเป็ด"
Liang(1, 4) = "ผีกินไก่"
Liang(1, 5) = "ผีกินหมู"
Liang(1, 6) = "ผีกินช้างม้า"
Liang(1, 7) = "ผีกินวัวควาย"
Liang(1, 8) = "ผีกินผี"
Liang(1, 9) = "ผีกินคน"
Liang(1, 10) = "ผีกินเป็ด"
Liang(1, 11) = "ผีกินไก่"
Liang(1, 12) = "ผีกินหมู"
Liang(1, 13) = "ผีกินช้างม้า"
Liang(1, 14) = "ผีกินวัวควาย"
Liang(1, 15) = "ผีกินผี"
Liang(2, 1) = "ผีกินคน"
Liang(2, 2) = "ผีกินเป็ด"
Liang(2, 3) = "ผีกินไก่"
Liang(2, 4) = "ผีกินหมู"
Liang(2, 5) = "ผีกินช้างม้า"
Liang(2, 6) = "ผีกินวัวควาย"
Liang(2, 7) = "ผีกินผี"
Liang(2, 8) = "ผีกินคน"
Liang(2, 9) = "ผีกินเป็ด"
Liang(2, 10) = "ผีกินไก่"
Liang(2, 11) = "ผีกินหมู"
Liang(2, 12) = "ผีกินช้างม้า"
Liang(2, 13) = "ผีกินวัวควาย"
Liang(2, 14) = "ผีกินผี"
Liang(2, 15) = "ผีกินคน"
Trav(1) = "กาจับหลัก"
Trav(2) = "เกวียนหักตามทาง"
Trav(3) = "นกยางพาไป"
Trav(4) = "กาจับหลัก"
Trav(5) = "เกวียนหักตามทาง"
Trav(6) = "นกยางพาไป"
Trav(7) = "กาจับหลัก"
Trav(8) = "เกวียนหักตามทาง"
Trav(9) = "นกยางพาไป"
Trav(10) = "กาจับหลัก"
Trav(11) = "เกวียนหักตามทาง"
Trav(12) = "นกยางพาไป"
Trav(13) = "กาจับหลัก"
Trav(14) = "เกวียนหักตามทาง"
Trav(15) = "นกยางพาไป"
'ดิถีมหาสูญ เดือน/ค่ำ
SupLoss(1) = 2
SupLoss(2) = 12
SupLoss(3) = 4
SupLoss(4) = 2
SupLoss(5) = 6
SupLoss(6) = 4
SupLoss(7) = 8
SupLoss(8) = 6
SupLoss(9) = 10
SupLoss(10) = 8
SupLoss(11) = 12
SupLoss(12) = 10
dt(0) = "อำมฤคโชค"
dt(1) = "สิทธิโชค"
dt(2) = "มหาสิทธิโชค"
dt(3) = "ราชาโชค"
dt(4) = "ชัยโชค"
dt(5) = "ทักทิน"
dt(6) = "ทรทึก"
dt(7) = "ยมขันธ์"
dt(8) = "ทัคธทิน"
dt(9) = "อัคนิโรธ"
dt(10) = "ทินกาล"
dt(11) = "ทินสูร"
dt(12) = "กาลโชค"
dt(13) = "กาลสูร"
dt(14) = "กาลทัณฑ์"
dt(15) = "โลกาวินาศ"
dt(16) = "วินาศ"
dt(17) = "พิลา"
dt(18) = "มฤตยู"
dt(19) = "วันบอด"
dt(20) = "กาลทิน"
dt(21) = "พิฆาต"
dt(22) = "พระกาล"
'ดึงค่าวัน
wkDay = Weekday(iDate) - 1
lDay = THLDate(iDate, , , , , , , True)
lMon = val(Right(lDay, 2))
slDay = Left(lDay, 4)
sDay = val(Right(slDay, 2)) 'ค่ำ
slDay = val(Left(slDay, 1)) 'ขึ้น-แรม
dt1 = Array(Amma(wkDay), _
Sitt(wkDay), _
Maha(wkDay), _
Raja(wkDay), _
Chai(wkDay), _
Takt(wkDay), _
Tora(wkDay), _
Yomk(wkDay), _
Takt(wkDay), _
Akni(wkDay), _
Tink(wkDay), _
Tins(wkDay), _
Kalc(wkDay), _
Kals(wkDay), _
Kalta(wkDay), _
Loka(wkDay), _
Vina(wkDay), _
Pila(wkDay), _
Mari(wkDay), _
Blin(wkDay), _
Kalti(wkDay), _
Pika(wkDay), _
Prak(wkDay))
'ค้นหาว่าในวันที่กำหนดมีตรงกับข้างขึ้นหรือข้างแรมหรือไม่
'ดิถีฤกษ์
Result = ""
dt2 = ""
For i = 0 To 22 Step 1
If dt1(i) = sDay Then
dt2 = dt(i) & ", " & dt2
'Debug.Print i & " - " & Dt(i) & " - " & Dt1(i) & " - " & sDay
End If
Next
If dt2 <> "" Then
Result = dt2
Dt01 = dt2
Else
Result = ChrW(160)
Dt01 = ChrW(160)
End If
'Debug.Print "ดิถีฤกษ์:" & Result
If Result = ChrW(160) Then
Result = "ดิถีฤกษ์:ปลอด"
Dt01 = "ดิถีฤกษ์:ปลอด"
Else
Result = "ดิถีฤกษ์:" & Result
Dt01 = "ดิถีฤกษ์:" & Dt01
End If
'ดีถีหัวเรียงหมอน
Select Case slDay
Case 1
Result = Result & ", " & "หมอน:" & Morn(1, sDay) & ", "
Dt02 = Morn(1, sDay)
Case 0
Result = Result & ", " & "หมอน:" & Morn(2, sDay) & ", "
Dt02 = Morn(2, sDay)
End Select
'ดิถีหว่าน
Select Case slDay
Case 1
Result = Result & "หว่าน:" & Waan(1, sDay) & ", "
Dt03 = Waan(1, sDay)
Case 0
Result = Result & "หว่าน:" & Waan(2, sDay) & ", "
Dt03 = Waan(2, sDay)
End Select
'ดิถีเลี้ยง
Select Case slDay
Case 1
Result = Result & "ผีกิน:" & Liang(1, sDay) & ", "
Dt04 = Liang(1, sDay)
Case 0
Result = Result & "ผีกิน:" & Liang(2, sDay) & ", "
Dt04 = Liang(2, sDay)
End Select
'ดิถีเดินทาง
Result = Result & "เดินทาง:" & Trav(sDay)
Dt05 = Trav(sDay)
'ดิถีมหาสูญ
If sDay = SupLoss(lMon) Then Result = Result & ", ดิถีมหาสูญ"
Dt06 = SupLoss(lMon)
If AsSep > 0 Then
Select Case AsSep
Case 1 'เฉพาะดีถีฤกษ์
Result = Dt01
Case 2 'เฉพาะเรียงหมอน
Result = Dt02
Case 3 'เฉพาะหว่าน
Result = Dt03
Case 4 'เฉพาะผีกิน
Result = Dt04
Case 5 'เฉพาะเดินทาง
Result = Dt05
Case 6 'เฉพาะดีถีฤกษ์กับเรียงหมอน
Result = Dt01 & ", เรียงหมอน:" & Dt02
Case 7 'เฉพาะดิถีฤกษ์กับหว่าน
Result = Dt01 & ", หว่าน:" & Dt03
Case 8 'เฉพาะดิถีฤกษ์กับเลี้ยง
Result = Dt01 & ", ผีกิน:" & Dt04
Case 9 'เฉพาะดิถีฤกษ์กับเดินทาง
Result = Dt01 & ", เดินทาง:" & Dt05
Case Else
Result = "ไม่รองรับ"
End Select
End If
'จัดเข้า Array
'Debug.Print Result
Result = Replace(Result, ", , ", ", ")
Result = Split(Result, ", ")
If AsRow = True And AsOne = False Then Result = Application.WorksheetFunction.Transpose(Result)
If AsOne = True And AsRow = False Then
Result = Application.WorksheetFunction.ArrayToText(Result)
Result = Replace(Result, ", ", " ")
End If
If AsRow = True And AsOne = True Then
Result = Application.WorksheetFunction.ArrayToText(Result)
Result = Replace(Result, ", ", vbLf)
End If
thDithi = Result
End Function
Public Function LNLDate(iDate As Date, Optional DispNumber As Integer = 0, Optional Zodiac As Integer = 0, Optional Era As Integer = 0, Optional DhammaDay As Boolean = False, Optional NumberOnly As Boolean = False)
'LNLDate = Lanna Lunar Date สำหรับแสดงผลวันที่แบบจันทรคติล้านนา
'แปลงวันที่แบบสุริยคติให้เป็นจันทรคติ
'Copyright 2022 and later by Pongsathorn Sraouthai
'Version 2.0 Optimized for faster calculation
'Inspired by Loy's calculation
'ตัวแปร
'iDate = วันที่ ที่ใช้อ้างอิง
'DispNumber = แสดงผลตัวเลข 0 เลขอารบิก 1 เลขไทย 2 เลขโหราล้านนา
'Zodiac = แสดงชื่อปี 0 ไม่เสดง 1 ปีนักษัตรไทย 2 ปีหนไท
'Era = แสดงศักราช 0 ไม่แสดง 1 พุทธศักราช 2 จุลศักราช
'DhammaDay = ถ้าเป็น True แสดงธรรมจักรในวันพระ
Dim DayInYear
Dim BeginDate As Date
Dim PrevYear, CurrYear
Dim i As Integer, j As Integer
Dim ThM, DofY, DofM, RDayPrev, DayOfYear, DayFromOne, NbLDayYear, ThS, ThZ, ThH, RDayLY, ThD1, ThD2, TmpD, ThK, jd
Dim sDate(1 To 56) As Date, cYear
'ตรวจสอบว่าเป็นปีที่รองรับการคำนวณได้หรือไม่
If year(iDate) < 1903 Or year(iDate) > 2460 Then
LNLDate = "ไม่รองรับ"
Exit Function
End If
'เลือก begin date ให้ใกล้สุดเพื่อที่จะได้ทำงานไวสุด
sDate(1) = DateSerial(1902, 10, 2)
sDate(2) = DateSerial(1912, 10, 10)
sDate(3) = DateSerial(1922, 9, 21)
sDate(4) = DateSerial(1932, 9, 29)
sDate(5) = DateSerial(1942, 10, 9)
sDate(6) = DateSerial(1952, 9, 18)
sDate(7) = DateSerial(1962, 9, 28)
sDate(8) = DateSerial(1972, 10, 7)
sDate(9) = DateSerial(1982, 9, 17)
sDate(10) = DateSerial(1992, 9, 26)
sDate(11) = DateSerial(2002, 10, 6)
sDate(12) = DateSerial(2012, 9, 15)
sDate(13) = DateSerial(2022, 9, 25)
sDate(14) = DateSerial(2032, 10, 4)
sDate(15) = DateSerial(2042, 10, 14)
sDate(16) = DateSerial(2052, 9, 23)
sDate(17) = DateSerial(2062, 10, 3)
sDate(18) = DateSerial(2072, 10, 11)
sDate(19) = DateSerial(2082, 9, 22)
sDate(20) = DateSerial(2092, 9, 30)
sDate(21) = DateSerial(2102, 10, 11)
sDate(22) = DateSerial(2112, 9, 20)
sDate(23) = DateSerial(2122, 9, 30)
sDate(24) = DateSerial(2132, 10, 9)
sDate(25) = DateSerial(2142, 9, 19)
sDate(26) = DateSerial(2152, 9, 28)
sDate(27) = DateSerial(2162, 10, 8)
sDate(28) = DateSerial(2172, 9, 17)
sDate(29) = DateSerial(2182, 9, 27)
sDate(30) = DateSerial(2192, 10, 6)
sDate(31) = DateSerial(2202, 10, 17)
sDate(32) = DateSerial(2212, 9, 26)
sDate(33) = DateSerial(2222, 10, 6)
sDate(34) = DateSerial(2232, 10, 14)
sDate(35) = DateSerial(2242, 9, 25)
sDate(36) = DateSerial(2252, 10, 3)
sDate(37) = DateSerial(2262, 10, 13)
sDate(38) = DateSerial(2272, 9, 22)
sDate(39) = DateSerial(2282, 10, 2)
sDate(40) = DateSerial(2292, 10, 11)
sDate(41) = DateSerial(2302, 9, 22)
sDate(42) = DateSerial(2312, 10, 1)
sDate(43) = DateSerial(2322, 10, 11)
sDate(44) = DateSerial(2332, 9, 20)
sDate(45) = DateSerial(2342, 9, 30)
sDate(46) = DateSerial(2352, 10, 9)
sDate(47) = DateSerial(2362, 10, 19)
sDate(48) = DateSerial(2372, 9, 28)
sDate(49) = DateSerial(2382, 10, 8)
sDate(50) = DateSerial(2392, 10, 16)
sDate(51) = DateSerial(2402, 9, 27)
sDate(52) = DateSerial(2412, 10, 5)
sDate(53) = DateSerial(2422, 10, 15)
sDate(54) = DateSerial(2432, 9, 25)
sDate(55) = DateSerial(2442, 10, 4)
sDate(56) = DateSerial(2452, 10, 13)
cYear = year(iDate) - 1
Select Case cYear
Case Is > 2452
BeginDate = sDate(56)
Case Is > 2442
BeginDate = sDate(55)
Case Is > 2432
BeginDate = sDate(54)
Case Is > 2422
BeginDate = sDate(53)
Case Is > 2412
BeginDate = sDate(52)
Case Is > 2402
BeginDate = sDate(51)
Case Is > 2392
BeginDate = sDate(50)
Case Is > 2382
BeginDate = sDate(49)
Case Is > 2372
BeginDate = sDate(48)
Case Is > 2362
BeginDate = sDate(47)
Case Is > 2352
BeginDate = sDate(46)
Case Is > 2342
BeginDate = sDate(45)
Case Is > 2332
BeginDate = sDate(44)
Case Is > 2322
BeginDate = sDate(43)
Case Is > 2312
BeginDate = sDate(42)
Case Is > 2302
BeginDate = sDate(41)
Case Is > 2292
BeginDate = sDate(40)
Case Is > 2282
BeginDate = sDate(39)
Case Is > 2272
BeginDate = sDate(38)
Case Is > 2262
BeginDate = sDate(37)
Case Is > 2252
BeginDate = sDate(36)
Case Is > 2242
BeginDate = sDate(35)
Case Is > 2232
BeginDate = sDate(34)
Case Is > 2222
BeginDate = sDate(33)
Case Is > 2212
BeginDate = sDate(32)
Case Is > 2202
BeginDate = sDate(31)
Case Is > 2192
BeginDate = sDate(30)
Case Is > 2182
BeginDate = sDate(29)
Case Is > 2172
BeginDate = sDate(28)
Case Is > 2162
BeginDate = sDate(27)
Case Is > 2152
BeginDate = sDate(26)
Case Is > 2142
BeginDate = sDate(25)
Case Is > 2132
BeginDate = sDate(24)
Case Is > 2122
BeginDate = sDate(23)
Case Is > 2112
BeginDate = sDate(22)
Case Is > 2102
BeginDate = sDate(21)
Case Is > 2092
BeginDate = sDate(20)
Case Is > 2082
BeginDate = sDate(19)
Case Is > 2072
BeginDate = sDate(18)
Case Is > 2062
BeginDate = sDate(17)
Case Is > 2052
BeginDate = sDate(16)
Case Is > 2042
BeginDate = sDate(15)
Case Is > 2032
BeginDate = sDate(14)
Case Is > 2022
BeginDate = sDate(13)
Case Is > 2012
BeginDate = sDate(12)
Case Is > 2002
BeginDate = sDate(11)
Case Is > 1992
BeginDate = sDate(10)
Case Is > 1982
BeginDate = sDate(9)
Case Is > 1972
BeginDate = sDate(8)
Case Is > 1962
BeginDate = sDate(7)
Case Is > 1952
BeginDate = sDate(6)
Case Is > 1942
BeginDate = sDate(5)
Case Is > 1932
BeginDate = sDate(4)
Case Is > 1922
BeginDate = sDate(3)
Case Is > 1912
BeginDate = sDate(2)
Case Is > 1902
BeginDate = sDate(1)
End Select
'นับวารถึงปีก่อนหน้าปีปัจจุบัน
For i = year(BeginDate) + 1 To year(iDate) - 1
DayInYear = LDayInYear(i)
PrevYear = DateAdd("d", DayInYear, BeginDate)
BeginDate = PrevYear
Next i
RDayPrev = DateDiff("d", PrevYear, DateSerial(year(PrevYear), 12, 31)) 'จำนวนวารที่เหลืออยู่ของปี นับจาก ขึ้น 1 ค่ำเดือน 1
DayOfYear = DateDiff("d", DateSerial(year(iDate), 1, 1), iDate) 'จำนวนวันของปีที่ถึงวันที่ที่กำหนด
DayFromOne = RDayPrev + DayOfYear + 1 'จำนวนวารจากขึ้น ๑ ค่ำ เดือน ๑ + จำนวนวารที่เหลือในปีถัดไป
NbLDayYear = LDayInYear(year(iDate)) 'จำนวนวารของปี
'จำแนกชนิดของปีปัจจุบัน
Select Case NbLDayYear
Case 354 'ปีปกติ
RDayLY = RDayPrev + NODIYear(year(iDate))
DofY = DayFromOne
For j = 1 To 16
ThM = j
Select Case j
Case 1
If DofY <= 29 And DofY > 0 Then Exit For Else DofY = DofY - 29
Case 2
If DofY <= 30 And DofY > 0 Then Exit For Else DofY = DofY - 30
Case 3
If DofY <= 29 And DofY > 0 Then Exit For Else DofY = DofY - 29
Case 4
If DofY <= 30 And DofY > 0 Then Exit For Else DofY = DofY - 30
Case 5
If DofY <= 29 And DofY > 0 Then Exit For Else DofY = DofY - 29
Case 6
If DofY <= 30 And DofY > 0 Then Exit For Else DofY = DofY - 30
Case 7
If DofY <= 29 And DofY > 0 Then Exit For Else DofY = DofY - 29
Case 8
If DofY <= 30 And DofY > 0 Then Exit For Else DofY = DofY - 30
Case 9
If DofY <= 29 And DofY > 0 Then Exit For Else DofY = DofY - 29
Case 10
If DofY <= 30 And DofY > 0 Then Exit For Else DofY = DofY - 30
Case 11
If DofY <= 29 And DofY > 0 Then Exit For Else DofY = DofY - 29
Case 12
If DofY <= 30 And DofY > 0 Then Exit For Else DofY = DofY - 30
Case 13
If DofY <= 29 And DofY > 0 Then Exit For Else DofY = DofY - 29
Case 14
If DofY <= 30 And DofY > 0 Then Exit For Else DofY = DofY - 30
Case 15
If DofY <= 29 And DofY > 0 Then Exit For Else DofY = DofY - 29
Case 16
If DofY <= 30 And DofY > 0 Then Exit For Else DofY = DofY - 30
Case Else
End Select
Next
'ช่วงขึ้นปีใหม่ของราชการ
If ThM > 12 Then
ThM = ThM - 12
ThZ = 1
Else
ThZ = 0
End If
If NumberOnly = True Then
If DofY > 15 Then
ThS = "-"
DofY = DofY - 15
Else
ThS = "+"
End If
LNLDate = ThS & Format(DofY, "00") & Format(ThM, "00")
Else
If DofY > 15 Then
ThS = " แรม "
DofY = DofY - 15
Else
ThS = " ออก "
End If
LNLDate = "เดือน " & ThM & ThS & DofY & " ค่ำ"
End If
Case 355 'ปีอธิกวาร
RDayLY = RDayPrev + NODIYear(year(iDate))
DofY = DayFromOne
For j = 1 To 16
ThM = j
Select Case j
Case 1
If DofY <= 29 And DofY > 0 Then Exit For Else DofY = DofY - 29
Case 2
If DofY <= 30 And DofY > 0 Then Exit For Else DofY = DofY - 30
Case 3
If DofY <= 29 And DofY > 0 Then Exit For Else DofY = DofY - 29
Case 4
If DofY <= 30 And DofY > 0 Then Exit For Else DofY = DofY - 30
Case 5
If DofY <= 29 And DofY > 0 Then Exit For Else DofY = DofY - 29
Case 6
If DofY <= 30 And DofY > 0 Then Exit For Else DofY = DofY - 30
Case 7
If DofY <= 29 And DofY > 0 Then Exit For Else DofY = DofY - 29
Case 8
If DofY <= 30 And DofY > 0 Then Exit For Else DofY = DofY - 30
Case 9
If DofY <= 30 And DofY > 0 Then Exit For Else DofY = DofY - 30
Case 10
If DofY <= 30 And DofY > 0 Then Exit For Else DofY = DofY - 30
Case 11
If DofY <= 29 And DofY > 0 Then Exit For Else DofY = DofY - 29
Case 12
If DofY <= 30 And DofY > 0 Then Exit For Else DofY = DofY - 30
Case 13
If DofY <= 29 And DofY > 0 Then Exit For Else DofY = DofY - 29
Case 14
If DofY <= 30 And DofY > 0 Then Exit For Else DofY = DofY - 30
Case 15
If DofY <= 29 And DofY > 0 Then Exit For Else DofY = DofY - 29
Case 16
If DofY <= 30 And DofY > 0 Then Exit For Else DofY = DofY - 30
Case Else
End Select
Next
If ThM > 12 Then
ThM = ThM - 12
ThZ = 1
Else
ThZ = 0
End If
If NumberOnly = True Then
If DofY > 15 Then
ThS = "-"
DofY = DofY - 15
Else
ThS = "+"
End If
LNLDate = ThS & Format(DofY, "00") & Format(ThM, "00")
Else
If DofY > 15 Then
ThS = " แรม "
DofY = DofY - 15
Else
ThS = " ออก "
End If
LNLDate = "เดือน " & ThM & ThS & DofY & " ค่ำ"
End If
Case 384 'ปีอธิกมาส
RDayLY = RDayPrev + NODIYear(year(iDate))
DofY = DayFromOne
For j = 1 To 17
ThM = j
Select Case j
Case 1
If DofY <= 29 And DofY > 0 Then Exit For Else DofY = DofY - 29
Case 2
If DofY <= 30 And DofY > 0 Then Exit For Else DofY = DofY - 30
Case 3
If DofY <= 29 And DofY > 0 Then Exit For Else DofY = DofY - 29
Case 4
If DofY <= 30 And DofY > 0 Then Exit For Else DofY = DofY - 30
Case 5
If DofY <= 29 And DofY > 0 Then Exit For Else DofY = DofY - 29
Case 6
If DofY <= 30 And DofY > 0 Then Exit For Else DofY = DofY - 30
Case 7
If DofY <= 29 And DofY > 0 Then Exit For Else DofY = DofY - 29
Case 8
If DofY <= 30 And DofY > 0 Then Exit For Else DofY = DofY - 30
Case 9
If DofY <= 30 And DofY > 0 Then Exit For Else DofY = DofY - 30
Case 10
If DofY <= 29 And DofY > 0 Then Exit For Else DofY = DofY - 29
Case 11
If DofY <= 30 And DofY > 0 Then Exit For Else DofY = DofY - 30
Case 12
If DofY <= 29 And DofY > 0 Then Exit For Else DofY = DofY - 29
Case 13
If DofY <= 30 And DofY > 0 Then Exit For Else DofY = DofY - 30
Case 14
If DofY <= 29 And DofY > 0 Then Exit For Else DofY = DofY - 29
Case 15
If DofY <= 30 And DofY > 0 Then Exit For Else DofY = DofY - 30
Case 16
If DofY <= 29 And DofY > 0 Then Exit For Else DofY = DofY - 29
Case 17
If DofY <= 30 And DofY > 0 Then Exit For Else DofY = DofY - 30
Case Else
End Select
Next
If ThM > 13 Then
ThM = ThM - 13
ThZ = 1
Else
ThZ = 0
End If
Select Case ThM
Case 11
ThM = 10
Case 12
ThM = 11
Case 13
ThM = 12
End Select
If NumberOnly = True Then
If DofY > 15 Then
ThS = "-"
DofY = DofY - 15
Else
ThS = "+"
End If
LNLDate = ThS & Format(DofY, "00") & Format(ThM, "00")
'LNLDate = ThS & DofY & " ค่ำ เดือน " & ThM
Else
If DofY > 15 Then
ThS = " แรม "
DofY = DofY - 15
Else
ThS = " ออก "
End If
LNLDate = "เดือน " & ThM & ThS & DofY & " ค่ำ"
End If
End Select
'แสดงตัวเลข
Select Case DispNumber
Case 0
LNLDate = LNLDate 'เลขอารบิก
Case 1
LNLDate = W2TH(CStr(LNLDate)) 'เลขไทย
Case 2
LNLDate = W2LN(CStr(LNLDate)) 'เลขโหรา
End Select
'แสดงชื่อปี
Select Case Zodiac
Case 1
LNLDate = LNLDate & " ปี" & ThZodiac(year(iDate))
Case 2
jd = ThLSokDay(year(iDate), 2)
Select Case iDate
Case Is < jd
LNLDate = LNLDate & " ปี" & ThHonThai(year(iDate) - 1)
Case Is >= jd
LNLDate = LNLDate & " ปี" & ThHonThai(year(iDate))
End Select
Case Else
End Select
'แสดงปีศักราช ถ้าตัวเลือก Era เป็น 1-5
Select Case Era
Case 1
Select Case DispNumber
Case 2
LNLDate = W2LN(LNLDate & " พุทธศักราช " & year(iDate) + 543)
Case 1
LNLDate = W2TH(LNLDate & " พุทธศักราช " & year(iDate) + 543)
Case 0
LNLDate = LNLDate & " พุทธศักราช " & year(iDate) + 543
End Select
Case 2
jd = ThLSokDay(year(iDate), 2)
Select Case iDate
Case Is < jd
Select Case DispNumber
Case 2
LNLDate = W2TH(LNLDate & " จุลศักราช " & year(iDate) - 639)
Case 1
LNLDate = W2TH(LNLDate & " จุลศักราช " & year(iDate) - 639)
Case 0
LNLDate = LNLDate & " จุลศักราช " & year(iDate) - 639
End Select
Case Is >= jd
Select Case DispNumber
Case 2
LNLDate = W2TH(LNLDate & " จุลศักราช " & year(iDate) - 638)
Case 1
LNLDate = W2TH(LNLDate & " จุลศักราช " & year(iDate) - 638)
Case 0
LNLDate = LNLDate & " จุลศักราช " & year(iDate) - 638
End Select
End Select
Case Else
End Select
'แสดงธรรมจักรในวันพระ
If DhammaDay = True Then
LNLDate = LNLDate & LNDmDay(iDate)
End If
If NumberOnly = True Then
'แสดงข้อมูลในลักษณะตัวเลข
'000000
'^^ 10 = ข้างขึ้น 00 = ข้างแรม
' ^^ = ค่ำ
' ^^ = เดือน
LNLDate = Replace(LNLDate, "+", "10")
LNLDate = Replace(LNLDate, "-", "00")
End If
LNLDate = Trim(LNLDate)
End Function
Function W2LN(strInput As String) As String
'Convert Western number to Lanna Hora number
Dim numberArray
Dim i As Long
numberArray = Array("0", ChrW(6784), _
"1", ChrW(6785), _
"2", ChrW(6786), _
"3", ChrW(6787), _
"4", ChrW(6788), _
"5", ChrW(6789), _
"6", ChrW(6790), _
"7", ChrW(6791), _
"8", ChrW(6792), _
"9", ChrW(6793))
W2LN = strInput
For i = 0 To 18 Step 2
W2LN = Replace(W2LN, numberArray(i), numberArray(i + 1))
Next i
End Function
Public Function LNDmDay(iDate As Date)
'สำหรับแสดงวันพระ แบบล้านนา
'7446 ขึ้น 8
'7447 แรม 8
'9675 ขึ้น15
'9679 แรม14-15
'9784 ธรรมจักร
Dim nDate, n1, n2, n3
nDate = LNLDate(iDate, , , , , True)
n1 = Mid(nDate, 1, 1)
n2 = Mid(nDate, 3, 2)
n3 = Mid(nDate, 5, 2)
Select Case n1
Case "1"
Select Case n2
Case "08"
LNDmDay = ChrW(9784)
Case "15"
LNDmDay = ChrW(9784)
Case Else
LNDmDay = ""
End Select
Case "0"
Select Case n2
Case "08"
LNDmDay = ChrW(9784)
Case "14"
Select Case LDayInYear(year(iDate))
Case 354
If val(n3) Mod 2 = 1 Then LNDmDay = ChrW(9784) Else LNDmDay = ""
Case 355
If val(n3) Mod 2 = 1 And val(n3) <> 9 Then LNDmDay = ChrW(9784) Else LNDmDay = ""
Case 384
If val(n3) Mod 2 = 1 Then LNDmDay = ChrW(9784) Else LNDmDay = ""
End Select
Case "15"
LNDmDay = ChrW(9784)
Case Else
LNDmDay = ""
End Select
End Select
End Function
Public Function ThLSokDay(iYear As Integer, Optional OType As Integer = 0) As Date
'ค้นหาวันเถลิงศกในปี ค.ศ. ที่ระบุ
Dim JYear
Dim Result As Date
Dim d1, d2, d3, d4, d5, d6
JYear = iYear - 638 'แปลงเป็นจุลศักราช
d1 = JYear * 0.25875
d2 = d1 + Int(JYear / 100 + 0.38)
d3 = d2 - Int(JYear / 4 + 0.5)
d4 = d3 - Int(JYear / 400 + 0.595)
d5 = d4 - 5.53375
d6 = Abs(d5 - Int(d5))
Result = DateSerial(iYear, 4, Int(d5))
Result = Result + d6
'Selection.NumberFormat = "dd/mm/yyyy HH:MM:SS"
Select Case OType
Case 0 'แสดงเป็นวันที่
ThLSokDay = Result
Case 1 'แสดงเฉพาะเลขวันที่
ThLSokDay = Int(d5)
Case 2 'ตัดทศนิยมออก
ThLSokDay = Int(Result)
End Select
End Function
Function THLunarDate2(iYear As Integer, iMonth As Integer, iDay As Integer, Optional iHour As Integer = 8, Optional iMinute As Integer = 0, Optional ProvinceCode As Integer = 10, Optional DateMode As Boolean = False, Optional ThaiNumber As Boolean = True)
'ฟังชั่นนี้จะแสดงวันเดือนปีทางจันทรคติแบบเต็มเท่านั้น
'ตัวอย่าง วันอังคาร ขึ้น ๑ ค่ำ เดือน ๖ ปีเถาะ พุทธศักราช ๒๕๓๐ (แบบราชการ) ขึ้นวันใหม่เวลา 0.00 น.
'หรือ วันอังคาร ขึ้น ๑ ค่ำ เดือน ๖ ปีเถาะนพศก จุลศักราช ๑๓๔๙ (แบบโหร) ขึ้นวันใหม่เวลาดวงอาทิตย์ขึ้น
'ฟังชั่นนี้จะใช้ THLDate มาอ้างอิงด้วย
'ตัวแปรต่างๆ
'iYear = ปี พ.ศ. รองรับตั้งแต่ปี 2445 เป็นต้นไป
'iMonth = เดือน (เลข 1-12)
'iDay = วันที่
'iHour = นาฬิกา
'iMinute = นาที
'ProvinceCode = รหัสจังหวัดที่ใช้อ้างอิง
'DateMode = False = แบบราชการ (เปลี่ยนปีนักษัตรเมื่อ ขึ้น 1 ค่ำ เดือน 1) True = แบบโทร (เปลี่ยนปีนักษัตรเมื่อ ขึ้น 1 ค่ำ เดือน 5)
'ThaiNumber = False = แบบอารบิก True = แบบไทย
Dim iDate As Date
Dim iTime As Date, SunriseTime As Date, TZ As Date
Dim iDayofW As String
Dim Result
iDate = DateSerial(iYear - 543, iMonth, iDay)
iTime = TimeSerial(iHour, iMinute, 0)
TZ = TimeSerial(7, 0, 0)
Select Case DateMode
Case False 'แบบราชการ
iDayofW = Format(iDate, "dddd")
Select Case ThaiNumber
Case False
Result = THLDate(iDate, False, 1, 1)
Result = "วัน" & iDayofW & " " & Result
Case True
Result = THLDate(iDate, True, 1, 1)
Result = "วัน" & iDayofW & " " & Result
End Select
Case True 'แบบโหร
'Get time of sunrise
SunriseTime = SunRiseCal(PVLocation(ProvinceCode, 4, 2), PVLocation(ProvinceCode, 4, 3), TZ, iDate)
If iTime < SunriseTime Then iDate = iDate - 1
iDayofW = Format(iDate, "dddd")
Select Case ThaiNumber
Case False
Result = THLDate(iDate, False, 2, 2, True)
Result = "วัน" & iDayofW & " " & Result
Case True
Result = THLDate(iDate, True, 2, 2, True)
Result = "วัน" & iDayofW & " " & Result
End Select
End Select
THLunarDate2 = Result
End Function
Function THLunarDate(iDate As Date, Optional iTime As Date = #8:00:00 AM#, Optional ProvinceCode As Integer = 10, Optional DateMode As Boolean = False, Optional ThaiNumber As Boolean = True, Optional MonthName As Boolean = False)
'ฟังชั่นนี้จะแสดงวันเดือนปีทางจันทรคติแบบเต็มเท่านั้น
'ตัวอย่าง วันอังคาร ขึ้น ๑ ค่ำ เดือน ๖ ปีเถาะ พุทธศักราช ๒๕๓๐ (แบบราชการ) ขึ้นวันใหม่เวลา 0.00 น.
'หรือ วันอังคาร ขึ้น ๑ ค่ำ เดือน ๖ ปีเถาะนพศก จุลศักราช ๑๓๔๙ (แบบโหร) ขึ้นวันใหม่เวลาดวงอาทิตย์ขึ้น
'ฟังชั่นนี้จะใช้ THLDa te มาอ้างอิงด้วย
'ตัวแปรต่างๆ
'iDate = วันที่สากล
'iTime = เวลา
'ProvinceCode = รหัสจังหวัดที่ใช้อ้างอิง
'DateMode = False = แบบราชการ (เปลี่ยนปีนักษัตรเมื่อ ขึ้น 1 ค่ำ เดือน 1) True = แบบโทร (เปลี่ยนปีนักษัตรเมื่อ ขึ้น 1 ค่ำ เดือน 5)
'ThaiNumber = False = แบบอารบิก True = แบบไทย
'MonthName = False = ใช้เลขเดือน True = ใช้ชื่อเดือน
Dim SunriseTime As Date, TZ As Date
Dim iDayofW As String
Dim Result
TZ = TimeSerial(7, 0, 0)
Select Case DateMode
Case False 'แบบราชการ
iDayofW = Format(iDate, "dddd")
Select Case ThaiNumber
Case False
Result = THLDate(iDate, False, 1, 1)
Result = "วัน" & iDayofW & " " & Result
Case True
Result = THLDate(iDate, True, 1, 1)
Result = "วัน" & iDayofW & " " & Result
End Select
Case True 'แบบโหร
'Get time of sunrise
SunriseTime = SunRiseCal(PVLocation(ProvinceCode, 4, 2), PVLocation(ProvinceCode, 4, 3), TZ, iDate)
If iTime < SunriseTime Then iDate = iDate - 1
iDayofW = Format(iDate, "dddd")
Select Case ThaiNumber
Case False
Result = THLDate(iDate, False, 2, 2, True)
Result = "วัน" & iDayofW & " " & Result
Case True
Result = THLDate(iDate, True, 2, 2, True)
Result = "วัน" & iDayofW & " " & Result
End Select
End Select
THLunarDate = Result
End Function
Function SunRiseSet(iDate As Date, Optional iLat As Double = 13.751, Optional iLong As Double = 100.492, Optional iTimeZone As Date = #7:00:00 AM#, Optional OutputType As Integer = 0) As Variant
'Convert Date to Sun Data
'OutputType:
'0 (Default) Text in one row Example: อาทิตย์ขึ้น: 6:30:25 ทิศ: 112.3 เที่ยงวัน: 12:02:34 อาทิตย์ตก: 18:12:34 ทิศ: 234.5
'1 Multiple columns with header
'2 Multiple cells without header
'3 multiple rows with header
'4 multiple rows without header
'5 multiple line in one cell
'6 number only in one cell
Dim SunRise As Date
Dim SunRiseA As Double
Dim SunNoon As Date
Dim SunSet As Date
Dim SunsetA As Double
Dim SunApp As Date
Dim Result As Variant
SunRise = SunRiseCal(iLat, iLong, iTimeZone, iDate)
SunRiseA = SunAzimuthCal(iLat, iLong, iTimeZone, iDate, SunRise)
SunNoon = SolarNoonCal(iLat, iLong, iTimeZone, iDate)
SunSet = SunSetCal(iLat, iLong, iTimeZone, iDate)
SunsetA = SunAzimuthCal(iLat, iLong, iTimeZone, iDate, SunSet)
SunApp = SunSet - SunRise
Select Case OutputType
Case 0
Result = "อาทิตย์ขึ้น: " & SunRise & " ทิศ: " & Format(SunRiseA, "0.00") & ChrW(176) & "N เที่ยงวัน: " & SunNoon & " อาทิตย์ตก: " & SunSet & " ทิศ: " & Format(SunsetA, "0.00") & ChrW(176) & "N ระยะปรากฏ: " & SunApp
Case 1
Result = Array("อาทิตย์ขึ้น: " & SunRise, "ทิศ: " & Format(SunRiseA, "0.00") & ChrW(176) & "N", "เที่ยงวัน: " & SunNoon, "อาทิตย์ตก: " & SunSet, "ทิศ: " & Format(SunsetA, "0.00") & ChrW(176) & "N", "ระยะปรากฏ: " & SunApp)
Case 2
Result = Array(SunRise, SunRiseA, SunNoon, SunSet, SunsetA)
Case 3
Result = Array("อาทิตย์ขึ้น: " & SunRise, "ทิศ: " & Format(SunRiseA, "0.00") & ChrW(176) & "N", "เที่ยงวัน: " & SunNoon, "อาทิตย์ตก: " & SunSet, "ทิศ: " & Format(SunsetA, "0.00") & ChrW(176) & "N", "ระยะปรากฏ: " & SunApp)
Result = Application.WorksheetFunction.Transpose(Result)
Case 4
Result = Array(SunRise, SunRiseA, SunNoon, SunSet, SunsetA)
Result = Application.WorksheetFunction.Transpose(Result)
Case 5
Result = "อาทิตย์ขึ้น: " & SunRise & vbLf & " ทิศ: " & Format(SunRiseA, "0.00") & ChrW(176) & vbLf & " เที่ยงวัน: " & SunNoon & vbLf & " อาทิตย์ตก: " & SunSet & vbLf & " ทิศ: " & Format(SunsetA, "0.00") & ChrW(176) & vbLf & " ระยะปรากฏ: " & SunApp
Case 6
Result = Format(SunRise, "HH:MM:SS") & "," & Format(SunRiseA, "000.00") & "," & Format(SunNoon, "HH:MM:SS") & "," & Format(SunSet, "HH:MM:SS") & "," & Format(SunsetA, "000.00") & "," & Format(SunApp, "HH:MM:SS")
Case Else
Result = "ไม่รองรับ"
End Select
SunRiseSet = Result
End Function
Function MoonRiseSet(iDate As Date, Optional iLat As Double = 13.751, Optional iLong As Double = 100.492, Optional iTimeZone As Date = #7:00:00 AM#, Optional OutputType As Integer = 0) As Variant
'Convert Date to Sun Data
'OutputType:
'0 (Default) Text in one row Example: ดิถีจันทร์: 55.5% จันทร์ขึ้น: 6:30:25 ทิศ: 112.3 จันทร์ตก: 18:12:34 ทิศ: 234.5
'1 Multiple columns with header
'2 Multiple cells without header
'3 multiple rows with header
'4 multiple rows without header
'5 multiple line on one cell
'6 number only
Dim Moon_Phase As Double
Dim Moon_Rise As Date
Dim MoonRiseA As Double
Dim Moon_Set As Date
Dim MoonsetA As Double
Dim MoonApp As Date
Dim Result As Variant
Moon_Phase = MoonPhasePercent(iDate)
Moon_Rise = MoonRiseCal(iLat, iLong, iTimeZone, iDate)
MoonRiseA = MoonAzimuthCal(iLat, iLong, iDate, Moon_Rise, 3, iTimeZone)
Moon_Set = MoonSetCal(iLat, iLong, iTimeZone, iDate)
MoonsetA = MoonAzimuthCal(iLat, iLong, iDate, Moon_Set, 3, iTimeZone)
If Moon_Rise < Moon_Set Then
MoonApp = Moon_Set - Moon_Rise
Else
MoonApp = 1 - Moon_Rise + Moon_Set
End If
Select Case OutputType
Case 0
Result = "ดิถีจันทร์: " & FormatPercent(Moon_Phase, 1) & " จันทร์ขึ้น: " & Format(Moon_Rise, "HH:MM:SS") & " ทิศ: " & Format(MoonRiseA, "0.00") & ChrW(176) & "N จันทร์ตก: " & Format(Moon_Set, "HH:MM:SS") & " ทิศ: " & Format(MoonsetA, "0.00") & ChrW(176) & "N ระยะปรากฏ: " & MoonApp
Case 1
Result = Array("ดิถีจันทร์: " & FormatPercent(Moon_Phase, 1), "จันทร์ขึ้น: " & Format(Moon_Rise, "HH:MM:SS"), "ทิศ: " & Format(MoonRiseA, "0.00") & ChrW(176) & "N", "จันทร์ตก: " & Format(Moon_Set, "HH:MM:SS"), "ทิศ: " & Format(MoonsetA, "0.00") & ChrW(176) & "N", "ระยะปรากฏ: " & MoonApp)
Case 2
Result = Array(Moon_Phase, Moon_Rise, MoonRiseA, Moon_Set, MoonsetA)
Case 3
Result = Array("ดิถีจันทร์: " & FormatPercent(Moon_Phase, 1), "จันทร์ขึ้น: " & Format(Moon_Rise, "HH:MM:SS"), "ทิศ: " & Format(MoonRiseA, "0.00") & ChrW(176) & "N", "จันทร์ตก: " & Format(Moon_Set, "HH:MM:SS"), "ทิศ: " & Format(MoonsetA, "0.00") & ChrW(176) & "N", "ระยะปรากฏ: " & MoonApp)
Result = Application.WorksheetFunction.Transpose(Result)
Case 4
Result = Array(Moon_Phase, Moon_Rise, MoonRiseA, Moon_Set, MoonsetA)
Result = Application.WorksheetFunction.Transpose(Result)
Case 5
Result = "ดิถีจันทร์: " & FormatPercent(Moon_Phase, 1) & vbLf & " จันทร์ขึ้น: " & Format(Moon_Rise, "HH:MM:SS") & vbLf & " ทิศ: " & Format(MoonRiseA, "0.00") & ChrW(176) & "N" & vbLf & " จันทร์ตก: " & Format(Moon_Set, "HH:MM:SS") & vbLf & " ทิศ: " & Format(MoonsetA, "0.00") & ChrW(176) & "N" & vbLf & " ระยะปรากฏ: " & MoonApp
Case 6
Result = Format(Moon_Rise, "HH:MM:SS") & "," & Format(MoonRiseA, "000.00") & "," & Format(Moon_Set, "HH:MM:SS") & "," & Format(MoonsetA, "000.00") & "," & Format(MoonApp, "HH:MM:SS") & "," & FormatPercent(Moon_Phase, 1)
Case Else
Result = "ไม่รองรับ"
End Select
MoonRiseSet = Result
End Function
Public Function HonthaiDay(iDate As Date) As String
'สำหรับแปลงวันที่สากลเป็นวันหนไท
'ปีเริ่มต้น 1900
'ค่าเริ่มต้น
'ปี 1/1/1900 วัน กาบเส็ด(11), 31/12/1900 วันเปิกยี(15)
'เลขสิ้นปีจะมากกว่าเลขเริ่มปี 4 ในปีปกติ 5 ในปีอธิกสุรทิน
'เลขปีถัดไปจะมากกว่า 5 ในปีปกติ 6 ในปีอธิกสุรทิน
Dim BeginDG As Integer
Dim BeginYR As Integer
Dim cYear As Integer, cYT As Boolean
Dim i As Integer, CurrDG, tmp, tmp2, Result
cYear = year(iDate)
BeginYR = 1900
BeginDG = 11
'หาวันที่ 1/1 ว่าตรงกับอะไร
For i = BeginYR + 1 To cYear
cYT = AthikaSurathin(i)
If CurrDG = "" Then CurrDG = BeginDG
Select Case cYT
Case True
CurrDG = CurrDG + 6
Case False
CurrDG = CurrDG + 5
End Select
Next
If CurrDG > 60 Then
CurrDG = CurrDG Mod 60
End If
'ตรวจสอบว่าเหลือกี่วัน
tmp = 60 - CurrDG
'ตรวจว่าวันที่ที่ระบุ คือวันที่เท่าไรของปี
tmp2 = DateDiff("d", DateSerial(year(iDate), 1, 1), iDate)
Result = ThHonThai(tmp2 - tmp, "d")
HonthaiDay = Result
End Function
Function LNLunarDate(iDate As Date, Optional HonthaiMode As Boolean = False, Optional BuddhistEra As Boolean = True, Optional ThaiNumber As Boolean = True)
'แปลงวันที่ปกติเป็นวันที่จันทรคติล้านนาแบบเต็ม
'HonthaiMode True=เปิดใช้ปีหนไทและวันหนไท, False=ใช้วันแบบปัจจุบัน
'BuddhistEra True=ใช้พุทธศักราช False=ใช้จุลศักราช
'ThaiNumber True=ใช้เลขไทย False=ใช้เลขอารบิก
Dim Result As String, DayOfW, HTDay, HTYear, ZDYear
Select Case HonthaiMode
Case True
'ใช้วันหนไท
HTDay = HonthaiDay(iDate)
Select Case BuddhistEra
Case True
Result = "วัน" & HTDay & " " & LNLDate(iDate, , 2, 1)
Case False
Result = "วัน" & HTDay & " " & LNLDate(iDate, , 2, 2)
End Select
Case False
'ใช้วันปกติ
DayOfW = Format(iDate, "dddd")
Select Case BuddhistEra
Case True
Result = "วัน" & DayOfW & " " & LNLDate(iDate, , 1, 1)
Case False
Result = "วัน" & DayOfW & " " & LNLDate(iDate, , 1, 2)
End Select
End Select
Select Case ThaiNumber
Case True
Result = W2TH(Result)
Case False
Result = Result
End Select
LNLunarDate = Result
End Function
Function Date2JDay(iDate As Date)
'Convert date to Julian Day
Date2JDay = iDate + 2415018.5
End Function
Public Function Date2YMD(InputDate As Range, Optional DispStyle = "V")
'makes it easier to extract Year, Month, DayOfMonth, DayOfYear from date
'DispStyle: "H" Horizontal "V" Vertical
Dim i As Long, r
r = InputDate
ReDim a(1 To 1, 1 To 4)
a(1, 1) = year(r)
a(1, 2) = month(r)
a(1, 3) = day(r)
a(1, 4) = r - DateSerial(year(r), 1, 0)
Select Case DispStyle
Case "H", "h"
Date2YMD = a
Case "V", "v"
Date2YMD = Application.WorksheetFunction.Transpose(a)
Case Else
Date2YMD = "H for horizontal, V for vertical"
End Select
End Function
Public Function ThaiTime(InTime, Optional TimeType As Integer = 1)
'แปลงเลขเวลาเป็นคำอ่าน
'TimeType รองรับได้ 6 แบบ
'1 ระบบ 24 ชั่วโมงแบบราชการ
'2 ระบบ 6 ชั่วโมงแบบ 2490
'3 ระบบ 6 ชั่วโมงแบบใหม่
'4 ระบบ 24 ชั่วโมงแบบทหาร
'5 ระบบ 8 ยาม แบบอยุธยา 2076
'6 ระบบ 8 ยาม แบบรัตนโกสินทร์ 2443
Dim Th6h(23), Thm6h(23), tInput, ThH, ThM, ThS
Dim ThYm, ThNl, ThBt, ThNt, ThPn, ThPr, DSec, ThNv, ThDN
'Classic
Th6h(0) = "เที่ยงคืน"
Th6h(1) = "ตีหนึ่ง"
Th6h(2) = "ตีสอง"
Th6h(3) = "ดีสาม"
Th6h(4) = "ตีสี่"
Th6h(5) = "ตีห้า"
Th6h(6) = "ย่ำรุ่ง"
Th6h(7) = "โมงเช้า"
Th6h(8) = "สองโมง"
Th6h(9) = "สามโมง"
Th6h(10) = "สี่โมง"
Th6h(11) = "ห้าโมง"
Th6h(12) = "เที่ยงวัน"
Th6h(13) = "บ่ายโมง"
Th6h(14) = "บ่ายสองโมง"
Th6h(15) = "บ่ายสามโมง"
Th6h(16) = "บ่ายสี่โมง"
Th6h(17) = "บ่ายห้าโมง"
Th6h(18) = "ย่ำค่ำ"
Th6h(19) = "ทุ่มหนึ่ง"
Th6h(20) = "สองทุ่ม"
Th6h(21) = "สามทุ่ม"
Th6h(22) = "สี่ทุ่ม"
Th6h(23) = "ห้าทุ่ม"
'Modern
Thm6h(0) = "เที่ยงคืน"
Thm6h(1) = "ตีหนึ่ง"
Thm6h(2) = "ตีสอง"
Thm6h(3) = "ตีสาม"
Thm6h(4) = "ตีสี่"
Thm6h(5) = "ตีห้า"
Thm6h(6) = "หกโมงเช้า"
Thm6h(7) = "เจ็ดโมง"
Thm6h(8) = "แปดโมง"
Thm6h(9) = "เก้าโมง"
Thm6h(10) = "สิบโมง"
Thm6h(11) = "สิบเอ็ดโมง"
Thm6h(12) = "เที่ยงวัน"
Thm6h(13) = "บ่ายโมง"
Thm6h(14) = "บ่ายสอง"
Thm6h(15) = "บ่ายสาม"
Thm6h(16) = "สี่โมงเย็น"
Thm6h(17) = "ห้าโมงเย็น"
Thm6h(18) = "หกโมงเย็น"
Thm6h(19) = "หนึ่งทุ่ม"
Thm6h(20) = "สองทุ่ม"
Thm6h(21) = "สามทุ่ม"
Thm6h(22) = "สี่ทุ่ม"
Thm6h(23) = "ห้าทุ่ม"
Select Case VarType(InTime)
Case vbDate
'format as time
tInput = TimeValue(InTime)
ThH = hour(tInput)
ThM = Minute(tInput)
ThS = Second(tInput)
Case vbDecimal
'format as decimal
tInput = Int(InTime)
ThH = tInput
ThM = (InTime - tInput) * 100
ThS = 0
Case vbString
'format as text
If InStr(1, InTime, ":", vbTextCompare) >= 1 Then
tInput = TimeValue(InTime)
ThH = hour(tInput)
ThM = Minute(tInput)
ThS = Second(tInput)
ElseIf InStr(1, InTime, ".", vbTextCompare) >= 1 Then
tInput = TimeValue(Replace(InTime, ".", ":"))
ThH = hour(tInput)
ThM = Minute(tInput)
ThS = Second(tInput)
End If
Case vbDouble
'format as decimal
tInput = InTime
ThH = hour(tInput)
ThM = Minute(tInput)
ThS = Second(tInput)
Case Else
ThaiTime = "!!!"
End Select
Select Case TimeType
Case 1 '24 ชม. ราชการ
'If ThS >= 30 Then ThM = ThM + 1
ThaiTime = ThaiNSound(ThH, True) & "นาฬิกา " & ThaiNSound(ThM, True) & "นาที"
If ThS > 0 Then ThaiTime = ThaiTime & " " & ThaiNSound(ThS, True) & "วินาที"
Case 2 '6 ชม. 2490
'If ThS >= 45 Then ThM = ThM + 1
Select Case ThM
Case Is = 0
ThaiTime = Th6h(ThH)
Case Is = 30
ThaiTime = Th6h(ThH) & "ครึ่ง"
If InStr(1, ThaiTime, "ย่ำรุ่ง", vbTextCompare) > 0 Then ThaiTime = Replace(ThaiTime, "ย่ำรุ่ง", "ตีหก")
If InStr(1, ThaiTime, "ย่ำค่ำ", vbTextCompare) > 0 Then ThaiTime = Replace(ThaiTime, "ย่ำค่ำ", "หกโมง")
Case Is <= 45
ThaiTime = Th6h(ThH) & " " & ThaiNSound(ThM) & "นาที"
Case Is > 45
ThaiTime = "อีก" & ThaiNSound(60 - ThM) & "นาที " & Th6h(ThH + 1)
End Select
Case 3 '6 ชม. สมัยใหม่
'If ThS >= 45 Then ThM = ThM + 1
Select Case ThM
Case Is = 0
ThaiTime = Thm6h(ThH)
Case Is = 30
ThaiTime = Thm6h(ThH) & "ครึ่ง"
If InStr(1, ThaiTime, "เช้า", vbTextCompare) > 0 Then ThaiTime = Replace(ThaiTime, "เช้า", "")
If InStr(1, ThaiTime, "เย็น", vbTextCompare) > 0 Then ThaiTime = Replace(ThaiTime, "เย็น", "")
Case Is <= 45
ThaiTime = Thm6h(ThH) & " " & ThaiNSound(ThM) & "นาที"
Case Is > 45
ThaiTime = "อีก" & ThaiNSound(60 - ThM) & "นาที " & Thm6h(ThH + 1)
End Select
Case 4 '24 ชม. แบบทหาร
'If ThS >= 30 Then ThM = ThM + 1
If ThH < 10 And ThM < 10 Then
ThaiTime = "ศูนย์" & ThaiNSound(ThH) & "ศูนย์" & ThaiNSound(ThM)
ElseIf ThH < 10 And ThM >= 10 Then
ThaiTime = "ศูนย์" & ThaiNSound(ThH) & ThaiNString(ThM, "1")
ElseIf ThH >= 10 And ThM < 10 Then
ThaiTime = ThaiNSound(ThH, True) & "ศูนย์" & ThaiNString(ThM)
Else
ThaiTime = ThaiNSound(ThH, True) & "" & ThaiNString(ThM, "1")
End If
Case 5 '12 ชม. แบบอยุธยา
'Convert to second in a day
DSec = (ThH * 3600) + (ThM * 60) + ThS
'Convert to Yaam
If DSec < 21600 Then
DSec = DSec + 21600
Else
If DSec < (43200 + 21600) Then
DSec = DSec - 21600
Else
DSec = DSec - (43200 + 21600)
End If
End If
ThYm = Int(DSec / 10800)
ThNl = Int((((DSec / 10800) - ThYm) * 10800) / 3600)
ThBt = Int(((((((DSec / 10800) - ThYm) * 10800) / 3600) - ThNl) * 3600) / 360)
ThNt = Int((((((((((DSec / 10800) - ThYm) * 10800) / 3600) - ThNl) * 3600) / 360) - ThBt) * 360) / 90)
ThPn = Int(((((((((((((DSec / 10800) - ThYm) * 10800) / 3600) - ThNl) * 3600) / 360) - ThBt) * 360) / 90) - ThNt) * 90) / 6)
ThPr = Int(((((((((((((((DSec / 10800) - ThYm) * 10800) / 3600) - ThNl) * 3600) / 360) - ThBt) * 360) / 90) - ThNt) * 90) / 6) - ThPn) * 6)
ThNv = Int(DSec / 3600)
Select Case ThH
Case Is = 0
ThaiTime = "สองยาม"
Case Is = 1, 2, 4, 5, 19, 20, 22, 23
ThaiTime = ThaiNSound(ThNv) & "ทุ่ม"
Case Is = 3
ThaiTime = "สามยาม"
Case Is = 6
ThaiTime = "ย่ำรุ่ง"
Case Is = 7, 8, 9, 10, 11
ThaiTime = ThaiNSound(ThNv) & "นาฬิกา"
Case Is = 12
ThaiTime = "ย่ำเที่ยง"
Case Is = 13, 14, 15, 16, 17
ThaiTime = "ชายแล้ว" & ThaiNSound(ThNv - 6) & "นาฬิกา"
Case Is = 18
ThaiTime = "ย่ำค่ำ"
Case Is = 21
ThaiTime = "ยามหนึ่ง"
End Select
If ThBt > 0 Then ThaiTime = ThaiTime & " " & ThaiNSound(ThBt) & "บาท"
If ThNt > 0 Then ThaiTime = ThaiTime & " " & ThaiNSound(ThNt) & "นาฑี"
If ThPn > 0 Then ThaiTime = ThaiTime & " " & ThaiNSound(ThPn) & "เพ็ชรนาฑี"
If ThPr > 0 Then ThaiTime = ThaiTime & " " & ThaiNSound(ThPr) & "ปราณ"
Case 6 '12 ชม.แบบรัตนโกสินทร์ พ.ศ. 2443
'Convert to second in a day
DSec = (ThH * 3600) + (ThM * 60) + ThS
'Convert to Yaam
If DSec < 21600 Then
DSec = DSec + 21600
Else
If DSec < (43200 + 21600) Then
DSec = DSec - 21600
Else
DSec = DSec - (43200 + 21600)
End If
End If
ThNv = Int(DSec / 3600)
Select Case ThH
Case Is = 0
ThaiTime = "สองยาม"
If ThM > 0 Then ThaiTime = ThaiTime & " " & ThaiNSound(ThM, True) & "นาที"
Case Is = 1, 2, 4, 5, 20, 22, 23
ThaiTime = ThaiNSound(ThNv) & "ทุ่ม"
If ThM > 0 Then ThaiTime = ThaiTime & " " & ThaiNSound(ThM, True) & "นาที"
Case Is = 3
ThaiTime = "สามยาม"
If ThM > 0 Then ThaiTime = ThaiTime & " " & ThaiNSound(ThM, True) & "นาที"
Case Is = 6
ThaiTime = "ย่ำรุ่ง"
If ThM > 0 Then ThaiTime = ThaiTime & " " & ThaiNSound(ThM, True) & "นาที"
Case Is = 7
ThaiTime = "โมงเช้า"
If ThM > 0 Then ThaiTime = ThaiTime & " " & ThaiNSound(ThM, True) & "นาที"
Case Is = 8, 9, 10, 11
ThaiTime = ThaiNSound(ThNv) & "โมงเช้า"
If ThM > 0 Then ThaiTime = ThaiTime & " " & ThaiNSound(ThM, True) & "นาที"
Case Is = 12
ThaiTime = "ย่ำเที่ยง"
If ThM > 0 Then ThaiTime = ThaiTime & " " & ThaiNSound(ThM, True) & "นาที"
Case Is = 13
ThaiTime = "บ่ายโมง"
If ThM > 0 Then ThaiTime = ThaiTime & " " & ThaiNSound(ThM, True) & "นาที"
Case Is = 14, 15, 16, 17
ThaiTime = "บ่าย" & ThaiNSound(ThNv - 6) & "โมง"
If ThM > 0 Then ThaiTime = ThaiTime & " " & ThaiNSound(ThM, True) & "นาที"
Case Is = 18
ThaiTime = "ย่ำค่ำ"
If ThM > 0 Then ThaiTime = ThaiTime & " " & ThaiNSound(ThM, True) & "นาที"
Case Is = 19
ThaiTime = "ทุ่มหนึ่ง"
If ThM > 0 Then ThaiTime = ThaiTime & " " & ThaiNSound(ThM, True) & "นาที"
Case Is = 21
ThaiTime = "หนึ่งยาม"
If ThM > 0 Then ThaiTime = ThaiTime & " " & ThaiNSound(ThM, True) & "นาที"
End Select
Case Else
ThaiTime = "#N/A"
End Select
End Function
Public Function EnglishTime(InTime, Optional Formal As Integer = 1)
'Convert Time to English Text
'Formal
'1 = Formal
'2 = Informal
'3 = Military
Dim tInput, ThH, ThM, ThS
Select Case VarType(InTime)
Case vbDate
'format as time
tInput = TimeValue(InTime)
ThH = hour(tInput)
ThM = Minute(tInput)
ThS = Second(tInput)
Case vbDecimal
'format as decimal
tInput = Int(InTime)
ThH = tInput
ThM = (InTime - tInput) * 100
ThS = 0
Case vbString
'format as text
If InStr(1, InTime, ":", vbTextCompare) >= 1 Then
tInput = TimeValue(InTime)
ThH = hour(tInput)
ThM = Minute(tInput)
ThS = Second(tInput)
ElseIf InStr(1, InTime, ".", vbTextCompare) >= 1 Then
tInput = TimeValue(Replace(InTime, ".", ":"))
ThH = hour(tInput)
ThM = Minute(tInput)
ThS = Second(tInput)
End If
Case vbDouble
'format as decimal
tInput = InTime
ThH = hour(tInput)
ThM = Minute(tInput)
ThS = Second(tInput)
Case Else
EnglishTime = "!!!"
End Select
Select Case Formal
Case 1 'Formal
If ThH > 12 Then ThH = ThH - 12
Select Case ThH
Case Is = 0
If ThM = 0 Then
EnglishTime = "mid night"
ElseIf ThM > 0 And ThM < 10 Then
EnglishTime = EngNSound(12) & " oh " & EngNSound(ThM)
Else
EnglishTime = EngNSound(12) & "-" & EngNSound(ThM)
End If
Case Is < 12
If ThM = 0 Then
EnglishTime = EngNSound(ThH) & " o'clock"
ElseIf ThM > 0 And ThM < 10 Then
EnglishTime = EngNSound(ThH) & " oh " & EngNSound(ThM)
Else
EnglishTime = EngNSound(ThH) & "-" & EngNSound(ThM)
End If
Case Is = 12
If ThM = 0 Then
EnglishTime = "noon"
ElseIf ThM > 0 And ThM < 10 Then
EnglishTime = EngNSound(ThH) & " oh " & EngNSound(ThM)
Else
EnglishTime = EngNSound(ThH) & "-" & EngNSound(ThM)
End If
End Select
Case 2 'Informal
If ThH > 12 Then ThH = ThH - 12
Select Case ThM
Case Is = 0
Select Case ThH
Case Is = 0
EnglishTime = "mid night"
Case Is > 0, Is < 12
EnglishTime = EngNSound(ThH) & " o'clock"
Case Is = 12
EnglishTime = "noon"
End Select
Case Is < 15
EnglishTime = EngNSound(ThM) & " pass " & EngNSound(ThH)
Case Is = 15
EnglishTime = "a quarter pass " & EngNSound(ThH)
Case Is < 30
EnglishTime = EngNSound(ThM) & " pass " & EngNSound(ThH)
Case Is = 30
EnglishTime = "half pass " & EngNSound(ThH)
Case Is < 45
ThH = ThH + 1
If ThH > 12 Then ThH = ThH - 12
ThM = 60 - ThM
EnglishTime = EngNSound(ThM) & " to " & EngNSound(ThH)
Case Is = 45
ThH = ThH + 1
If ThH > 12 Then ThH = ThH - 12
EnglishTime = "a quarter to " & EngNSound(ThH)
Case Is <= 59
ThH = ThH + 1
If ThH > 12 Then ThH = ThH - 12
ThM = 60 - ThM
EnglishTime = EngNSound(ThM) & " to " & EngNSound(ThH)
End Select
Case 3 'Military
Select Case ThH
Case Is = 0
Select Case ThM
Case Is = 0
EnglishTime = "Zero hundred hours"
Case Is < 10
EnglishTime = "Zero hundred Zero " & EngNSound(ThM) & " hours"
Case Else
EnglishTime = "Zero Zero " & EngNSound(ThM) & " hours"
End Select
Case Is < 10
Select Case ThM
Case Is = 0
EnglishTime = "Zero " & EngNSound(ThH) & " hundred hours"
Case Is < 10
EnglishTime = "Zero " & EngNSound(ThH) & " Zero " & EngNSound(ThM) & " hours"
Case Else
EnglishTime = "Zero " & EngNSound(ThH) & " " & EngNSound(ThM) & " hours"
End Select
Case Else
Select Case ThM
Case Is = 0
EnglishTime = EngNSound(ThH) & " hundred hours"
Case Is < 10
EnglishTime = EngNSound(ThH) & " Zero " & EngNSound(ThM) & " hours"
Case Else
EnglishTime = EngNSound(ThH) & " " & EngNSound(ThM) & " hours"
End Select
End Select
Case Else
EnglishTime = "!!!"
End Select
EnglishTime = LCase(EnglishTime)
End Function
'NB_DAYS for check number day of month
Public Function NB_DAYS(date_test As Date)
NB_DAYS = day(DateSerial(year(date_test), month(date_test) + 1, 1) - 1)
End Function
Public Function TODAYTHLUNAR(Optional DateStyle As Integer = 0, Optional YearStyle As Boolean = False)
'Display Thai Lunar Date for today
Dim tDate As Date
tDate = DateSerial(year(Date), month(Date), day(Date))
Select Case DateStyle
Case 0 'Normal Style ขึ้น 1 ค่ำ เดือน 1
TODAYTHLUNAR = THLDate(tDate, False)
Case 1 'Thai Number ขึ้น ๑ ค่ำ เดือน ๑
TODAYTHLUNAR = THLDate(tDate, True)
Case 2 'With Year ขึ้น 1 ค่ำ เดือน 1 ปีเถาะ
TODAYTHLUNAR = THLDate(tDate, , 1, , YearStyle)
Case 3 'With year ขึ้น ๑ ค่ำ เดือน ๑
TODAYTHLUNAR = THLDate(tDate, True, 1, , YearStyle)
Case Else
TODAYTHLUNAR = "#N/A"
End Select
End Function
Public Function THLMonth(MonthNumber As Integer, YearNumber As Integer, Optional Lang As String = "S")
'Convert month number to lunar month name
Dim mp(14) As String, MS(14) As String, AtkM As Boolean
mp(1) = "มาคสิรมาส"
mp(2) = "ปุสสมาส"
mp(3) = "มาฆมาส"
mp(4) = "ผัคคุณมาส"
mp(5) = "จิตตมาส"
mp(6) = "วิสาขมาส"
mp(7) = "เชฏฐมาส"
mp(8) = "อาสาฬหมาส"
mp(9) = "สาวนมาส"
mp(10) = "ภัททปทมาส"
mp(11) = "อัสสยุชมาส"
mp(12) = "กัตติกมาส"
mp(13) = "ปุพพาสาฬหมาส"
mp(14) = "อุตราสาฬหมาส"
MS(1) = "มารฺคศีรฺษมาส"
MS(2) = "เปาษมาส"
MS(3) = "มาฆมาส"
MS(4) = "ผาลฺคุนมาส"
MS(5) = "ไจตฺรมาส"
MS(6) = "ไวศาขมาส"
MS(7) = "เชยษฺฐมาส"
MS(8) = "อาษาฒมาส"
MS(9) = "ศฺราวณมาส"
MS(10) = "ภาทฺรปทมาส"
MS(11) = "อาศฺวินมาส"
MS(12) = "การฺติกมาส"
MS(13) = "บูรพาษาฒมาส"
MS(14) = "อุตราษาฒมาส"
AtkM = AthikaMas(YearNumber)
If AtkM = True Then
If MonthNumber = 8 Then MonthNumber = 13
If MonthNumber = 88 Then MonthNumber = 14
End If
Select Case Lang
Case "P", "p"
THLMonth = mp(MonthNumber)
Case "S", "s"
THLMonth = MS(MonthNumber)
End Select
End Function
Public Function ILDT2Date(DayName As String, Optional YearNumber As Integer = 0, Optional OType As Integer = 0)
'Convert Important Lunar Days of Thailand to Normal Date
'ค้นหาวันสำคัญของปีที่ระบุว่าตรงกับวันที่เท่าไร
'YearNumber ปีสากล (ค.ศ.)
'DayName ชื่อวันสำคัญทางจันทรคติที่ระบุ
'Otype ชนิดของผลลัพธ์
'0 = ตัวเลขลำดับวันที่ (สามารถจัดรูปแบบเป็นวันที่ได้ 1 = วันที่(ข้อความ) 2 = ตัวเลขจำนวนวันนับจาก 1 ม.ค.
'วันสำคัญที่รองรับ
'มาฆบูชา วิสาขบูชา อัฏฐมีบูชา อาสาฬหบูชา เข้าพรรษา สารท ออกพรรษา ลอยกระทง
'จุลศักราชใหม่ (ขึ้น 1 ค่ำ เดือน 5) นักษัตรใหม่(ขึ้น 1 ค่ำ เดือน 1)
'ตัวอย่างเช่น =GetTHLDate(2023, "วิสาขบูชา")
Dim d1, D11, D12, D13, Dr
Dim Ya, Yb, Yc
Dim rs
If YearNumber = 0 Then YearNumber = year(Date)
'ตรวจสอบว่าวันที่ 1 ม.ค.ตรงกับวันที่เท่าไร
d1 = THLDate(DateSerial(YearNumber, 1, 1), , , , , , , True)
D11 = val(Left(d1, 1)) 'ข้างขึ้น-แรม
D12 = val(Mid(d1, 3, 2)) 'ค่ำ
D13 = val(Right(d1, 2)) 'เดือน
'ตรวจสอบปีว่าเป็น อธิกมาส, อธิกวาร
If AthikaMas(YearNumber) = True Then Ya = 29 Else Ya = 0 'อธิกมาส
If AthikaVar(YearNumber) = True Then Yb = 1 Else Yb = 0 'อธิกวาร
If AthikaSurathin(YearNumber) = True Then Yc = 1 Else Yc = 0 'อธิกสุรทิน
Select Case DayName
Case Is = "ตักบาตรข้าวหลาม", "วันตักบาตรข้าวหลาม", "ประเพณีตักบาตรข้าวหลาม" '101502
Select Case D13
Case 1 'กรณีเดือน 1
If D11 = 0 Then 'ข้างแรม
Dr = 29 - (D12 + 15) + 15
End If
Case 2 'กรณีเดือน 2
If D11 = 0 Then 'ข้างแรม
Dr = 30 - (D12 + 15) + 296 + 43
If Ya > 0 Then Dr = Dr + 30 'อธิกมาส
If Yb > 0 Then Dr = Dr + Yb 'อธิกวาร
Else 'ข้างขึ้น
Dr = 30 - D12 - 15
End If
End Select
Case Is = "มาฆบูชา", "วันมาฆบูชา" '101503, 101504
Select Case D13
Case 1
If D11 = 0 Then
Dr = 29 - D12 + 30
Else
Dr = 29 - D12 + 15
End If
Case 2
If D11 = 0 Then
Dr = 30 - D12
Else
Dr = 30 - D12 + 15
End If
End Select
If Ya > 0 Then Dr = Dr + Ya
Case Is = "วิสาขบูชา", "วันวิสาขบูชา" '101506, 101507
Select Case D13
Case 1
If D11 = 0 Then
Dr = 29 - (D12 + 15) + 133
Else
Dr = 29 - D12 + 133
End If
If Ya > 0 Then Dr = Dr + 29
Case 2
If D11 = 0 Then
Dr = 30 - (D12 + 15) + 103
Else
Dr = 30 - D12 + 103
End If
If Ya > 0 Then Dr = Dr + 30
End Select
Case Is = "อัฏฐมีบูชา", "วันอัฏฐมีบูชา" '000806, 000807
Select Case D13
Case 1
If D11 = 0 Then
Dr = 29 - (D12 + 15) + 141
Else
Dr = 29 - D12 + 141
End If
If Ya > 0 Then Dr = Dr + 29
Case 2
If D11 = 0 Then
Dr = 30 - (D12 + 15) + 111
Else
Dr = 30 - D12 + 111
End If
If Ya > 0 Then Dr = Dr + 30
End Select
Case Is = "อาสาฬหบูชา", "วันอาสาฬหบูชา" '101508, 101588
Select Case D13
Case 1
If D11 = 0 Then
Dr = 29 - (D12 + 15) + 192
Else
Dr = 29 - D12 + 192
End If
If Ya > 0 Then Dr = Dr + 29
Case 2
If D11 = 0 Then
Dr = 30 - (D12 + 15) + 162
Else
Dr = 30 - D12 + 162
End If
If Ya > 0 Then Dr = Dr + 30
End Select
If Yb > 0 Then Dr = Dr + Yb
Case Is = "เข้าพรรษา", "วันเข้าพรรษา" '000108
Select Case D13
Case 1
If D11 = 0 Then
Dr = 29 - (D12 + 15) + 193
Else
Dr = 29 - D12 + 193
End If
If Ya > 0 Then Dr = Dr + 29
Case 2
If D11 = 0 Then
Dr = 30 - (D12 + 15) + 163
Else
Dr = 30 - D12 + 163
End If
If Ya > 0 Then Dr = Dr + 30
End Select
If Yb > 0 Then Dr = Dr + Yb
Case Is = "ข้าวประดับดิน", "วันข้าวประดับดิน", "ข้าวบิณฑ์", "วันข้าวบิณฑ์" '001409
Select Case D13
Case 1
If D11 = 0 Then
Dr = 29 - (D12 + 15) + 236
Else
Dr = 29 - D12 + 236
End If
If Ya > 0 Then Dr = Dr + 29
Case 2
If D11 = 0 Then
Dr = 30 - (D12 + 15) + 206
Else
Dr = 30 - D12 + 206
End If
If Ya > 0 Then Dr = Dr + 30
End Select
If Yb > 0 Then Dr = Dr + Yb
Case Is = "ข้าวสลากภัต", "วันข้าวสลากภัต" '101510
Select Case D13
Case 1
If D11 = 0 Then
Dr = 29 - (D12 + 15) + 251
Else
Dr = 29 - D12 + 251
End If
If Ya > 0 Then Dr = Dr + 29
Case 2
If D11 = 0 Then
Dr = 30 - (D12 + 15) + 221
Else
Dr = 30 - D12 + 221
End If
If Ya > 0 Then Dr = Dr + 30
End Select
If Yb > 0 Then Dr = Dr + Yb
Case Is = "สารท", "วันสารท", "สารทไทย", "วันสารทไทย" '001510
Select Case D13
Case 1
If D11 = 0 Then
Dr = 29 - (D12 + 15) + 266
Else
Dr = 29 - D12 + 266
End If
If Ya > 0 Then Dr = Dr + 29
Case 2
If D11 = 0 Then
Dr = 30 - (D12 + 15) + 236
Else
Dr = 30 - D12 + 236
End If
If Ya > 0 Then Dr = Dr + 30
End Select
If Yb > 0 Then Dr = Dr + Yb
Case Is = "ออกพรรษา", "วันออกพรรษา" '101511
Select Case D13
Case 1
If D11 = 0 Then
Dr = 29 - (D12 + 15) + 281
Else
Dr = 29 - D12 + 281
End If
If Ya > 0 Then Dr = Dr + 29
Case 2
If D11 = 0 Then
Dr = 30 - (D12 + 15) + 251
Else
Dr = 30 - D12 + 251
End If
If Ya > 0 Then Dr = Dr + 30
End Select
If Yb > 0 Then Dr = Dr + Yb
Case Is = "ตักบาตรเทโว", "ตักบาตรเทโวโรหณะ", "วันตักบาตรเทโว", "วันตักบาตรเทโวโรหณะ" '000111
Select Case D13
Case 1
If D11 = 0 Then
Dr = 29 - (D12 + 15) + 282
Else
Dr = 29 - D12 + 282
End If
If Ya > 0 Then Dr = Dr + 29
Case 2
If D11 = 0 Then
Dr = 30 - (D12 + 15) + 252
Else
Dr = 30 - D12 + 252
End If
If Ya > 0 Then Dr = Dr + 30
End Select
If Yb > 0 Then Dr = Dr + Yb
Case Is = "ลอยกระทง", "วันลอยกระทง" '101512
Select Case D13
Case 1
If D11 = 0 Then
Dr = 29 - (D12 + 15) + 310
Else
Dr = 29 - D12 + 310
End If
If Ya > 0 Then Dr = Dr + 29
Case 2
If D11 = 0 Then
Dr = 30 - (D12 + 15) + 280
Else
Dr = 30 - D12 + 280
End If
If Ya > 0 Then Dr = Dr + 30
End Select
If Yb > 0 Then Dr = Dr + Yb
Case Is = "จุลศักราชใหม่", "วันจุลศักราชใหม่"
Select Case D13
Case 1
If D11 = 0 Then
Dr = 29 - (D12 + 15) + 90
Else
Dr = 29 - D12 + 90
End If
'If Ya > 0 Then Dr = Dr + 29
Case 2
If D11 = 0 Then
Dr = 30 - (D12 + 15) + 60
Else
Dr = 30 - D12 + 60
End If
'If Ya > 0 Then Dr = Dr + 30
End Select
Case Is = "นักษัตรใหม่", "วันนักษัตรใหม่"
Select Case D13
Case 1
If D11 = 0 Then
Dr = 29 - (D12 + 15) + 326
Else
Dr = 29 - D12 + 326
End If
If Ya > 0 Then Dr = Dr + 29
Case 2
If D11 = 0 Then
Dr = 30 - (D12 + 15) + 296
Else
Dr = 30 - D12 + 296
End If
If Ya > 0 Then Dr = Dr + 30
End Select
If Yb > 0 Then Dr = Dr + Yb
End Select
rs = DateAdd("d", Dr, DateSerial(YearNumber, 1, 1))
Select Case OType
Case 0
ILDT2Date = rs
Case 1
ILDT2Date = Format(rs, "d/m/yyyy")
Case 2
ILDT2Date = Dr
End Select
End Function
Public Function THLD2DATE(LunarDate As String, Optional YearNum As Integer = 0, Optional OType As Integer = 0)
'convert Lunar Date in THailand to Normal date
'LunarDate = String as Lunar date input such as "ขึ้น 1 ค่ำ เดือน 1" and can be use "ขึ้น ๑ ค่ำ เดือน ๑" instead.
'YearNum = the number of Year. Example: 2023 (Gregerian calendar only)
'OType = Output type: 0 = Number of serial date (Can formatting as Date) 1 = Date (as Text) 2 = Number of day from 1th Jan.
Dim d1, d2, d3, df, Dr
Dim Ndm(12), i, rs, sp
Dim T1, T2, T3
Dim A1 As Boolean, A2 As Boolean, A3 As Boolean
Ndm(1) = 29
Ndm(2) = 30
Ndm(3) = 29
Ndm(4) = 30
Ndm(5) = 29
Ndm(6) = 30
Ndm(7) = 29
Ndm(8) = 30
Ndm(9) = 29
Ndm(10) = 30
Ndm(11) = 29
Ndm(12) = 30
If YearNum = 0 Then
YearNum = year(Date)
End If
'Get 1 Jan Day information
df = THLDate(DateSerial(YearNum, 1, 1), , , , , , , True)
'Get information of 1 Jan
d1 = val(Left(df, 1)) 'ข้างขึ้น/ข้างแรม
If d1 = 0 Then d2 = val(Mid(df, 3, 2)) + 15 Else d2 = val(Mid(df, 3, 2)) 'ค่ำ
d3 = val(Right(df, 2)) 'เดือน
A1 = AthikaMas(YearNum)
A2 = AthikaVar(YearNum)
A3 = AthikaSurathin(YearNum)
'Get data from Lunar Date
LunarDate = TH2W(LunarDate)
sp = Split(LunarDate, " ")
Select Case sp(0)
Case Is = "แรม"
T1 = 0
T2 = ExtractNum(LunarDate, 8) + 15
If Len(LunarDate) <= 20 Then
T3 = val(ExtractNum(LunarDate, 4, "R"))
Else
LunarDate = Mid(LunarDate, 1, 20)
T3 = val(ExtractNum(LunarDate, 4, "R"))
End If
Case Is = "ขึ้น"
T1 = 1
T2 = ExtractNum(LunarDate, 8)
If Len(LunarDate) <= 20 Then
T3 = val(ExtractNum(LunarDate, 4, "R"))
Else
LunarDate = Mid(LunarDate, 1, 20)
T3 = val(ExtractNum(LunarDate, 4, "R"))
End If
End Select
Select Case d3
Case 1
Dr = 29 - d2
If T3 = 1 Then
For i = 2 To 12
Dr = Dr + Ndm(i)
Next
ElseIf T3 = 2 Then
Dr = Dr + 0
ElseIf T3 = 88 Then
For i = 2 To 8
Dr = Dr + Ndm(i)
Next
Dr = Dr - 30
Else
For i = 2 To T3 - 1
Dr = Dr + Ndm(i)
Next
End If
Dr = Dr + T2
Case 2
Dr = 30 - d2
If T3 = 1 Then
For i = 3 To 12
Dr = Dr + Ndm(i)
Next
ElseIf T3 = 2 Then
If d1 = 0 Then
For i = 3 To 12
Dr = Dr + Ndm(i)
Next
Dr = Dr + 29
Else
Dr = Dr - 30
End If
ElseIf T3 = 88 Then
For i = 3 To 8
Dr = Dr + Ndm(i)
Next
Dr = Dr - 30
Else
For i = 3 To T3 - 1
Dr = Dr + Ndm(i)
Next
End If
Dr = Dr + T2
End Select
If A1 = True And T3 >= 9 Then Dr = Dr + 30
If A2 = True And T3 >= 8 Then Dr = Dr + 1
rs = DateAdd("d", Dr, DateSerial(YearNum, 1, 1))
If A1 = True And month(rs) >= 11 Then rs = DateAdd("d", 30, rs)
If A2 = True And month(rs) >= 11 Then rs = DateAdd("d", 1, rs)
Select Case OType
Case 0
THLD2DATE = rs
Case 1
THLD2DATE = Format(rs, "d/m/yyyy")
Case 2
THLD2DATE = Dr
End Select
End Function
Private Function ExtractNum(inText As String, Optional LMDigit As Integer = 0, Optional Direction As String = "L") As Double
'Extract number from text with limit digit and direction from Left or Right
'InText = Text to extract
'LMDigit = number digit to limit 0 = no limit
'Direction = L = From left R = From Right
Dim Ls As Integer, po As Integer, tmp As String, Rt As String
If LMDigit = 0 Then
Ls = Len(inText)
Else
Ls = LMDigit
End If
tmp = ""
Select Case Direction
Case "L", "l"
Rt = Left(inText, Ls)
For po = 1 To Ls
If IsNumeric(Mid(Rt, po, 1)) = True Then
tmp = tmp & Mid(Rt, po, 1)
End If
Next
Case "R", "r"
Rt = Right(inText, Ls)
For po = 1 To Ls
If IsNumeric(Mid(Rt, po, 1)) = True Then
tmp = tmp & Mid(Rt, po, 1)
End If
Next
End Select
If Len(tmp) = 0 Then
ExtractNum = 0
Else
ExtractNum = CDbl(tmp)
End If
End Function
Public Function RT2DT(TimeInput, Optional TimeType As String = "H") As Double
'Convert Real Time to Decimal Time
'TimeInput should be time string like "00:00:00"
'OutputType for specified for output format:
'"H" (Default) for Hour
'"M" for minute
'"S" for second
Dim d1, d2, d3 'd1 = h, d2 = m, d3 = s
Dim l1, l2, T1
If VarType(TimeInput) = vbDate Then
T1 = Format(TimeInput, "HH:MM:SS")
ElseIf VarType(TimeInput) = vbString Then
T1 = TimeInput
Else
T1 = Format(TimeInput, "HH:MM:SS")
End If
l1 = Len(T1)
Select Case l1
Case 8, 7 'H+M+S
l2 = InStr(1, T1, ":")
If l2 = 2 Then 'Length = 7 (0:00:00)
d1 = Left(T1, 1)
d2 = Mid(T1, 3, 2)
d3 = Right(T1, 2)
ElseIf l2 = 3 Then 'Lenght = 8 (00:00:00)
d1 = Left(T1, 2)
d2 = Mid(T1, 4, 2)
d3 = Right(T1, 2)
End If
Case 5, 4 'M+S
l2 = InStr(1, T1, ":")
If l2 = 2 Then 'Length = 4 (0:00)
d1 = "0"
d2 = Left(T1, 1)
d3 = Right(T1, 2)
ElseIf l2 = 3 Then 'Lenght = 5 (00:00)
d1 = "0"
d2 = Left(T1, 2)
d3 = Right(T1, 2)
End If
Case 2, 1 'S only
d1 = "0"
d2 = "0"
d3 = T1
Case Else
d1 = 0
d2 = 0
d3 = 0
RT2DT = 0#
End Select
d1 = val(d1)
d2 = val(d2)
d3 = val(d3)
d2 = d2 / 60
d3 = d3 / 3600
RT2DT = d1 + d2 + d3
Select Case TimeType
Case "H", "h"
RT2DT = RT2DT * 1
Case "M", "m"
RT2DT = RT2DT * 60
Case "S", "s"
RT2DT = RT2DT * 3600
End Select
End Function
Public Function DT2RT(DecTime As Double, Optional TimeType As String = "H")
'Convert Decimal time to Real time
'TimeType
' "D" Day
' "H" Hour
' "M" Minute
' "S" Second
Dim d1, d2, d3, d4
Dim LangID
LangID = Application.International(xlCountryCode)
Select Case TimeType
Case "D", "d"
d1 = Int(DecTime) 'd
d2 = Int((DecTime - d1) * 24) 'h
d3 = Int((((DecTime - d1) * 24) - d2) * 60) 'm
d4 = Int((((((DecTime - d1) * 24) - d2) * 60) - d3) * 60) 's
Case "H", "h"
d1 = Int(DecTime / 24) 'd
d2 = Int((DecTime / 24 - d1) * 24) 'h
d3 = Int((((DecTime / 24 - d1) * 24) - d2) * 60) 'm
d4 = Int((((((DecTime / 24 - d1) * 24) - d2) * 60) - d3) * 60) 's
Case "M", "m"
d1 = Int(DecTime / 1440) 'd
d2 = Int((DecTime / 1440 - d1) * 24) 'h
d3 = Int((((DecTime / 1440 - d1) * 24) - d2) * 60) 'm
d4 = Int((((((DecTime / 1440 - d1) * 24) - d2) * 60) - d3) * 60) 's
Case "S", "s"
d1 = Int(DecTime / 86400) 'd
d2 = Int((DecTime / 86400 - d1) * 24) 'h
d3 = Int((((DecTime / 86400 - d1) * 24) - d2) * 60) 'm
d4 = Int((((((DecTime / 86400 - d1) * 24) - d2) * 60) - d3) * 60) 's
End Select
If d1 > 0 And d1 = 1 Then
Select Case LangID
Case 66
DT2RT = d1 & ":" & Format(TimeSerial(d2, d3, d4), "HH:MM:SS")
Case Else
DT2RT = d1 & ":" & Format(TimeSerial(d2, d3, d4), "HH:MM:SS")
End Select
ElseIf d1 > 1 Then
Select Case LangID
Case 66
DT2RT = d1 & ":" & Format(TimeSerial(d2, d3, d4), "HH:MM:SS")
Case Else
DT2RT = d1 & ":" & Format(TimeSerial(d2, d3, d4), "HH:MM:SS")
End Select
Else
DT2RT = Format(TimeSerial(d2, d3, d4), "HH:MM:SS")
End If
End Function
Public Function IsTime(Rng As Range) As Boolean
Dim sValue As String
sValue = Rng.Cells(1).text
On Error Resume Next
IsTime = IsDate(TimeValue(sValue))
On Error GoTo 0
End Function
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment