[VBA][Excel] สูตรสำหรับแปลงวันที่ปกติ (สุริยคติ) เป็น จันทรคติแบบไทย รวมถึงสูตรที่มีไว้สำหรับตรวจสอบ ปีอธิกมาส ปีอธิกวาร และ ปีอธิกสุรทิน

ThaiLunarDateExcel.bas

Option Explicit

Private Function XLMod(a, b)
'สำหรับใช้แทน mod ของ vba เนื่องจาก mod operator ของ vba ไม่รองรับเลขทศนิยม
    XLMod = a - b * Int(a / b)
End Function

Function AthikaMas(iYear As Integer) As Boolean
'สูตรสำหรับคำนวณปีอธิกมาส
'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

Function AthikaVar(iYear As Integer) As Boolean
'สูตรสำหรับคำนวณปีอธิกวาร
'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

'Debug.Print "Select = " & Fyear & " FDev: " & FDev

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
        'Debug.Print "First: " & Fyear & " input: " & iYear & " Loop: " & i & " CurrentDev: " & CurrDev
    Next i
End If

Deviation = CurrDev

End Function

Private Function LDayInYear(iYear As Integer)
'สำหรับใช้คำนวนวันใน 1 ปี แบบจันทรคติ
'return value of lunar days in year for Thai Lunar Date
If AthikaMas(iYear) = True Then
    LDayInYear = 384
ElseIf AthikaVar(iYear) = True Then
    LDayInYear = 355
Else
    LDayInYear = 354
End If
End Function

Function AthikaSurathin(iYear As Integer) As Boolean
'สูตรสำหรับคำนวณปีอธิกสุรทิน (Leap Year)
'return value true if it is a leap year.

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

Private Function NODIYear(iYear As Integer) As Integer
'NODIYEAR = Number of day in the year
'สำหรับแสดงจำนวนวันใน 1 ปีตามแบบสุริยคติ
'Copyright 2022 and later by Pongsathorn Sraouthai

Dim NBDay
If AthikaSurathin(iYear) = True Then
    NODIYear = 366
Else
    NODIYear = 365
End If

End Function

Function THLDate(iDate As Date, Optional ThaiNumber As Boolean = False, Optional ThaiZodiac As Boolean = False, Optional Era As Integer = 0, Optional ZOption As Boolean = False, Optional Holiday 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 = ถ้าเป็น True แสดงชื่อปีนักษัตร
'Era = แสดงศักราช 0=ไม่แสดง 1=พุทธศักราช 2=จุลศักราช 3=มหาศักราช 4=รัตนโกสินทร์ศก 5=คริสตศักราช
'Zoption = ตัวเลือกสำหรับการแสดงชื่อปีนักษัตร: False = ใช้รูปแบบราชการ, True = ใช้รูปแบบโหราศาสตร์ไทย
'Holiday = ถ้าเป็น 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
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 DofY > 15 Then
            ThS = "แรม "
            DofY = DofY - 15
        Else
            ThS = "ขึ้น "
        End If
        
        THLDate = ThS & DofY & " ค่ำ เดือน " & ThM
    
    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 DofY > 15 Then
            ThS = "แรม "
            DofY = DofY - 15
        Else
            ThS = "ขึ้น "
        End If
        
        THLDate = ThS & DofY & " ค่ำ เดือน " & ThM
    
    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 DofY > 15 Then
            ThS = "แรม "
            DofY = DofY - 15
        Else
            ThS = "ขึ้น "
        End If
        
        THLDate = ThS & DofY & " ค่ำ เดือน " & ThM
        
End Select

'เปิดใช้เลขไทย ถ้าตัวเลือก ThaiNumber เป็น True
If ThaiNumber = True Then THLDate = W2TH(CStr(THLDate))

'แสดงปีนักษัตร ตามระบบราชการ ถ้าตัวเลือก ThaiZodiac เป็น True
If ThaiZodiac = True Then
    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
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
        Select Case ThaiNumber
            Case True
                THLDate = W2TH(THLDate & " จุลศักราช " & Year(iDate) - 638)
            Case False
                THLDate = THLDate & " จุลศักราช " & Year(iDate) - 638
        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

THLDate = Trim(THLDate)

End Function

Function ThZodiac(iYear As Integer, Optional oType As Integer = 1)
'ThZodiac = Thai Zodiac Year Name
'สูตรสำหรับแปลงเลขปี ค.ศ. เป็นชื่อปีนักษัตร
'Copyright 2022 and later by Pongsathorn Sraouthai
'
'oType = Output Type
'1 = Thai
'2 = English
'3 = Number

Dim Zodiac(1 To 3, 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) = "DRAGON"
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

Result = iYear Mod 12
If Result - 3 < 1 Then
    Result = Result - 3 + 12
Else
    Result = Result - 3
End If

ThZodiac = Zodiac(oType, Result)

End Function

Function W2TH(strInput As String) As String
'สูตรสำหรับแปลงเลขอารบิกเป็นเลขไทย
    Dim numberArray
    numberArray = Array("0", ChrW(3664), _
                         "1", ChrW(3665), _
                         "2", ChrW(3666), _
                         "3", ChrW(3667), _
                         "4", ChrW(3668), _
                         "5", ChrW(3669), _
                         "6", ChrW(3670), _
                         "7", ChrW(3671), _
                         "8", ChrW(3672), _
                         "9", ChrW(3673))
    Dim i As Long
    W2TH = strInput
    For i = 0 To 18 Step 2
        W2TH = Replace(W2TH, numberArray(i), numberArray(i + 1))
    Next i
End Function

Function ThLunarHoliday(iDate As Date) 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 ค่ำ เดือน 11"
            ThLunarHoliday = "วันออกพรรษา"
        Case "ขึ้น 15 ค่ำ เดือน 12"
            ThLunarHoliday = "วันลอยกระทง"
        Case Else
            ThLunarHoliday = ""
    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 ค่ำ เดือน 11"
            ThLunarHoliday = "วันออกพรรษา"
        Case "ขึ้น 15 ค่ำ เดือน 12"
            ThLunarHoliday = "วันลอยกระทง"
        Case Else
            ThLunarHoliday = ""
    End Select
End If
End Function