Menghitung Hari Libur Keagamaan

Jika sebelumnya saya telah membagikan sebuah aplikasi Kalender Indonesia yang dilengkapi dengan hari-hari libur nasional dan keagamaan, dan prakiraan cuti bersama. Nah kali ini saya akan membahasa perumusan untuk menghitung hari libur nasional dan keagamaan yang berlaku di Indonesia.

Ayo, langsung saja ke prakteknya. Jalankan IDE VB6 Anda, buat sebuah project baru, kemudian tambahkan beberapa module pada project Anda, diantaranya:
- basIslam
- basKristen
- basHindu
- basBuddha
- basChina
- basNasional

Oke, tinggal menyalin kode yang berikut ini:

- basIslam

Option Explicit

Public IdulFitri As Date
Public IdulFitri2 As Date
Public IdulAdha As Date
Public MaulidNabi As Date
Public TahunBaruHijri As Date
Public IsraMiraj As Date

Public TahunIdulFitri As Long
Public TahunHijriyah As Long
Public TahunIdulAdha As Long
Public TahunMaulid As Long
Public TahunIsraMiraj As Long

Private Function intPart(floatNum)
    Dim lngReturn As Long
    
    If floatNum < -0.0000001 Then
        intPart = (floatNum - 0.0000001)
    End If
    
    intPart = Fix(floatNum + 0.0000001)
End Function

Private Function RoundDown(dblValue As Double) As Double
On Error GoTo PROC_ERR
Dim myDec As Long

myDec = InStr(1, CStr(dblValue), ".", vbTextCompare)
If myDec > 0 Then
    RoundDown = CDbl(Left(CStr(dblValue), myDec))
Else
    RoundDown = dblValue
End If

PROC_EXIT:
    Exit Function
PROC_ERR:
    MsgBox Err.Description, vbInformation, "Round Down"
End Function

Private Function RoundUp(dblValue As Double) As Double
On Error GoTo PROC_ERR
Dim myDec As Long

myDec = InStr(1, CStr(dblValue), ".", vbTextCompare)
If myDec > 0 Then
    RoundUp = CDbl(Left(CStr(dblValue), myDec)) + 1
Else
    RoundUp = dblValue
End If

PROC_EXIT:
    Exit Function
PROC_ERR:
    MsgBox Err.Description, vbInformation, "Round Up"
End Function

Private Function Trunc(dblValue As Double) As Long
On Error Resume Next
    Dim strValue As String
    
    If dblValue = 0 Then
        Trunc = 0
        Exit Function
    End If
    
    Dim myDec As Integer
    Dim Pisah() As String
    
    myDec = InStr(1, CStr(dblValue), ".", vbTextCompare)
    
    If myDec <> 0 Then
        Pisah = Split(CStr(dblValue), ".")
        strValue = Pisah(0)
    Else
        strValue = dblValue
    End If
    
    Trunc = CLng(strValue)
End Function

Public Function Masehi2Hijri(datMasehi As Date) As Date
    Dim dDay As Integer
    Dim dMonth As Integer
    Dim dYear As Long
    Const intAW As Long = 227016
    
    Dim intMonth As Integer
    Dim intYear As Integer
    
    Dim TA(0 To 12) As Integer
    Dim JH(0 To 12) As Integer
    Dim KA(0 To 12) As Integer
    
    Dim intAM1 As Long
    Dim intAM As Long
    Dim intAH As Long
    Dim intB As Integer
    Dim intThH1 As Integer
    Dim intDayCount As Integer
    Dim intAddYear As Integer
    Dim intTHM2 As Integer
    Dim intSisa As Integer
    Dim intModDay1 As Integer
    Dim intModDay2 As Integer
    Dim intBulan1 As Integer
    Dim x As Integer
        
    Dim intJmlHari As Integer
    Dim intSisaHari As Integer
    
    Dim dHijri As Integer
    Dim mHijri As Integer
    Dim yHijri As Integer
    Dim intODay As Integer
    
    Dim datResult As Date
    
    dDay = Day(datMasehi)
    dMonth = Month(datMasehi)
    dYear = Year(datMasehi)
    
    TA(0) = 29:    TA(1) = 30
    TA(2) = 29:    TA(3) = 30
    TA(4) = 29:    TA(5) = 30
    TA(6) = 29:    TA(7) = 30
    TA(8) = 29:    TA(9) = 30
    TA(10) = 29:    TA(11) = 30
    TA(12) = 29
    
    KA(0) = 0:    KA(1) = 2
    KA(2) = 5:    KA(3) = 7
    KA(4) = 10:    KA(5) = 13
    KA(6) = 16:    KA(7) = 18
    KA(8) = 21:    KA(9) = 24
    KA(10) = 26:    KA(11) = 29
    KA(12) = 32
    
    JH(0) = 0:    JH(1) = 30
    JH(2) = 59:    JH(3) = 89
    JH(4) = 118:    JH(5) = 148
    JH(6) = 177:    JH(7) = 207
    JH(8) = 236:    JH(9) = 266
    JH(10) = 295:    JH(11) = 325
    JH(12) = 354
    
    intMonth = IIf(dMonth < 3, dMonth + 12, dMonth)
    intYear = IIf(dMonth < 3, dYear - 1, dYear)
    
    intAM1 = Int(365.25 * intYear) + _
    Int(30.60001 * (intMonth + 1)) + dDay - 428
    intB = IIf(intAM1 < 577748, 0, 2 - _
    Int(intYear / 100) + Int(Int(intYear / 100) / 4))
    
    intAM = Int(365.25 * intYear) + _
    Int(30.60001 * (intMonth + 1)) + dDay + intB - 428
        
    intAH = intAM - intAW
    intThH1 = Int(intAH / 354.3671)
    
    intModDay1 = Round(intAH - 354.3671 * Int(intAH / 354.3671), 0.5)
    intModDay2 = RoundUp(intAH - 354.3671 * Int(intAH / 354.3671))
    
    intDayCount = IIf(intAH < 0, intModDay1, intModDay2)
    intAddYear = Int(intDayCount / 365)
    
    intTHM2 = intThH1 + intAddYear + 1
    intSisa = intDayCount Mod 365
    
    For x = 1 To 12
        If intSisa >= JH(x - 1) And intSisa <= JH(x) Then
            intBulan1 = x - 1
            Exit For
        End If
    Next
    
    intJmlHari = JH(intBulan1)
    intSisaHari = intSisa - intJmlHari
    
    dHijri = IIf(intSisaHari = 0, TA(intBulan1), intSisaHari)
    mHijri = IIf(intSisaHari = 0, intBulan1, _
    IIf((intBulan1 + 1) Mod 12 = 0, 12, (intBulan1 + 1) Mod 12))
    
    yHijri = intTHM2
    
    datResult = DateSerial(yHijri, mHijri, dHijri)
    Masehi2Hijri = datResult
End Function

Public Function Hijri2Masehi(datHijri As Date) As Date
    Dim dDay As Integer
    Dim dMonth As Integer
    Dim dYear As Long
    Dim datResult As Date
    
    Const intAW As Long = 227016
    
    dDay = Day(datHijri)
    dMonth = Month(datHijri)
    dYear = Year(datHijri)
    
    Dim intAH As Long
    Dim intAM As Long
    
    intAH = Trunc((11 * dYear) / 30) + _
            Trunc(354 * dYear) + _
            Trunc(30 * dMonth) - _
            Trunc((dMonth - 1) / 2) + dDay - 384
    
    intAM = intAH + intAW
    
    Dim intTHM1 As Long
    Dim intDayCount As Integer
    Dim intAddYear As Integer
    Dim intTHM2 As Long
    Dim intA As Integer
    Dim intB As Integer
    Dim intSisa As Integer
    
    intTHM1 = Int(intAM / 1461) * 4
    intDayCount = intAM Mod 1461
    intAddYear = Int(intDayCount / 365)
    
    intTHM2 = intTHM1 + intAddYear + 1
    intA = intDayCount Mod 365
    intB = IIf(intAM < 577748, 0, 2 - Int(intTHM2 / 100) + _
    Int(Int(intTHM2 / 100) / 4))
    
    intSisa = intA - intB
    
    Dim JH(0 To 12) As Integer
    Dim JLH(0 To 12) As Integer
    
    Dim intBulan1 As Integer
    Dim intMatch As Integer
    Dim x As Integer
    
    JH(0) = 31
    JH(1) = 31
    JH(2) = IIf((((intTHM2 Mod 4) = 0 Or (intTHM2 Mod 100) = 0) _
    Or (intTHM2 Mod 400) = 0), 29, 28)
    
    JH(3) = 31
    JH(4) = 30
    JH(5) = 31
    JH(6) = 30
    JH(7) = 31
    JH(8) = 31
    JH(9) = 30
    JH(10) = 31
    JH(11) = 30
    JH(12) = 31
    
    JLH(0) = 0
    JLH(1) = 31
    
    For x = 2 To 12
       JLH(x) = JLH(x - 1) + JH(x)
    Next
    
    For x = 1 To 12
        If intSisa >= JLH(x - 1) And intSisa <= JLH(x) Then
            intMatch = x - 1
            Exit For
        End If
    Next
    
    intBulan1 = IIf(intSisa < 31, 0, intMatch)
    
    Dim intJmlHari As Integer
    Dim intSisaHari As Integer
    
    intJmlHari = JLH(intBulan1)
    intSisaHari = intSisa - intJmlHari
    
    Dim dMasehi As Integer
    Dim mMasehi As Integer
    Dim yMasehi As Long
    
    dMasehi = IIf(intSisaHari = 0, JH(intBulan1), intSisaHari)
    mMasehi = IIf(intJmlHari = 0, intBulan1, _
    IIf((intBulan1 + 1) Mod 12 = 0, 12, (intBulan1 + 1) Mod 12))
    yMasehi = intTHM2
    
    datResult = DateSerial(yMasehi, mMasehi, dMasehi)
    Hijri2Masehi = datResult
End Function

Public Function Masehi2Hijri2(ByVal dDate As Date) As Date
    Dim j, k, l, n, jd
    Dim monthName As String
    Dim intDay As Integer, intMonth As Integer, intYear As Integer
    
    Dim arrFormat() As String
    Dim sSplit As String
    Dim strResult As String
    Dim sDay As String
    Dim sMonth As String
    Dim sYear As String
    
    intDay = Day(dDate)
    intMonth = Month(dDate)
    intYear = Year(dDate)
    
    If ((intYear > 1582) Or ((intYear = 1582) And (intMonth > 10)) _
        Or ((intYear = 1582) And (intMonth = 10) And (intDay > 14))) Then
        jd = intPart((1461 * (intYear + 4800 + _
        intPart((intMonth - 14) / 12))) / 4) + _
             intPart((367 * (intMonth - 2 - 12 * _
             (intPart((intMonth - 14) / 12)))) / 12) - _
             intPart((3 * (intPart((intYear + 4900 + _
             intPart((intMonth - 14) / 12)) / 100))) / 4) + intDay - 32075
    Else
        jd = 367 * intYear - intPart((7 * _
        (intYear + 5001 + intPart((intMonth - 9) / 7))) / 4) + _
        intPart((275 * intMonth) / 9) + intDay + 1729777
    End If
                    
    l = jd - 1948440 + 10632
    n = intPart((l - 1) / 10631)
    l = l - 10631 * n + 354
    
    j = (intPart((10985 - l) / 5316)) * (intPart((50 * l) / 17719)) + _
    (intPart(l / 5670)) * (intPart((43 * l) / 15238))
    
    l = l - (intPart((30 - j) / 15)) * (intPart((17719 * j) / 50)) - _
    (intPart(j / 16)) * (intPart((15238 * j) / 43)) + 29
    
    intMonth = intPart((24 * l) / 709)
    intDay = l - intPart((709 * intMonth) / 24)
    intYear = 30 * n + j - 30
    
    Masehi2Hijri2 = DateSerial(intYear, intMonth, intDay)
End Function

Public Function Hijri2Pasaran(datHijri As Date) As String
    Dim dDay As Integer
    Dim dMonth As Integer
    Dim dYear As Long
    Dim intAH As Long
    Dim intAM As Long
    Dim datResult As Date
    Dim PA(5) As String
    
    Const intAW As Long = 227016
    
    dDay = Day(datHijri)
    dMonth = Month(datHijri)
    dYear = Year(datHijri)
        
    intAH = Trunc((11 * dYear) / 30) + _
            Trunc(354 * dYear) + _
            Trunc(30 * dMonth) - _
            Trunc((dMonth - 1) / 2) + dDay - 384
    
    intAM = intAH + intAW
    
    PA(0) = "Wage"
    PA(1) = "Kliwon"
    PA(2) = "Legi"
    PA(3) = "Pahing"
    PA(4) = "Pon"
    
    Dim intMod As Integer
    
    intMod = intAM Mod 5
    Hijri2Pasaran = PA(intMod)
End Function

Public Sub Islam(intTahun As Integer)
On Error Resume Next
    Dim x As Integer
    Dim dDate As Date
    Dim datResult As Date
    Dim datHijri(1 To 366) As Date
    Dim datMasehi(1 To 366) As Date
    
    For x = 0 To 366
        dDate = DateAdd("d", x, DateSerial(intTahun, 1, 1))
        datMasehi(x) = dDate
        datHijri(x) = Masehi2Hijri(dDate)
        
        If Hijri2Masehi(datHijri(x)) <> datMasehi(x) Then
            datHijri(x) = Masehi2Hijri2(dDate)
            'If Hijri2Masehi(datHijri(x)) <> datMasehi(x) Then
                'datHijri(x) = DateAdd("d", -1, Masehi2Hijri(dDate))
            'End If
        End If
        
        Select Case Month(datHijri(x))
        Case 1
            If Day(datHijri(x)) = 1 Then
                TahunBaruHijri = datMasehi(x)
            End If
            TahunHijriyah = Year(datHijri(x))
        Case 3
            If Day(datHijri(x)) = 12 Then
                MaulidNabi = datMasehi(x)
            End If
            TahunMaulid = Year(datHijri(x))
        Case 7
            If Day(datHijri(x)) = 27 Then
                IsraMiraj = datMasehi(x)
            End If
            TahunIsraMiraj = Year(datHijri(x))
        Case 10
            If Day(datHijri(x)) = 1 Then
                IdulFitri = datMasehi(x)
            End If
            If Day(datHijri(x)) = 2 Then
                IdulFitri2 = datMasehi(x)
            End If
            TahunIdulFitri = Year(datHijri(x))
        Case 12
            If Day(datHijri(x)) = 10 Then
                IdulAdha = datMasehi(x)
            End If
            TahunIdulAdha = Year(datHijri(x))
        End Select
    Next
End Sub

- basKristen

Option Explicit

Public Paskah As Date
Public WafatIsa As Date
Public KenaikanIsa As Date
Public Natal As Date
Public TahunBaru As Date

Sub Kristen(intTahun As Integer)
    Dim intA As Integer
    Dim intB As Integer
    Dim intC As Integer
    Dim intD As Integer
    Dim intE As Integer
    Dim intF As Integer
    Dim intG As Integer
    Dim intH As Integer
    Dim intI As Integer
    Dim intJ As Integer
    Dim intK As Integer
    Dim intL As Integer
    Dim intM As Integer
    Dim intN As Integer
    Dim intO As Integer
    
    intA = intTahun Mod 19
    intB = intTahun Mod 4
    intC = intTahun Mod 7
    
    intH = IIf((intTahun >= 1900 And intTahun <= 2099), 5, 0)
    intI = IIf((intTahun >= 2100 And intTahun <= 2199), 6, 0)
    intJ = IIf((intTahun >= 2200 And intTahun <= 2299), 0, 0)
    intK = intH + intI + intJ
    intL = IIf((intTahun >= 1900 And intTahun <= 2099), 24, 0)
    intM = IIf((intTahun >= 2100 And intTahun <= 2199), 24, 0)
    intN = IIf((intTahun >= 2200 And intTahun <= 2299), 25, 0)
    intO = intL + intM + intN
    
    intD = ((19 * intA) + intO) Mod 30
    intE = ((2 * intB) + (4 * intC) + (6 * intD) + intK) Mod 7
    intF = IIf(intD + intE < 10, 3, 4)
    intG = IIf(intD + intE < 10, intD + intE + 22, intD + intE - 9)
    
    Paskah = DateSerial(intTahun, intF, intG)
    WafatIsa = DateAdd("d", -2, Paskah)
    KenaikanIsa = DateAdd("d", 39, Paskah)
    TahunBaru = DateSerial(intTahun, 1, 1)
    Natal = DateSerial(intTahun, 12, 25)
End Sub

- basHindu

Option Explicit

Public Nyepi As Date

Public Sub Hindu(iTahun As Integer)
    Dim TA(1 To 33) As Integer
    Const cTanggal As Integer = 28
    Const cBulan As Integer = 3

    Dim intBulan As Integer
    Dim intTahun As Integer
    Dim intAM1 As Long
    Dim intKoreksiGr As Long
    Dim intH As Long
    Dim intN As Long
    Dim intI As Integer
    Dim Ma As Integer
    Dim Mb As Integer
    Dim MbMin As Integer
    
    Dim cDateFull As Date
    
    Dim Ya As Integer
    Dim Yb As Integer

    Dim x As Integer
    
    Dim datMa As Date
    Dim datMb As Date
    
    Dim datA1 As Date
    Dim datA2 As Date
        
    Dim lngMa As Long
    Dim lngMb As Long
    
    Dim intResult As Long
    Dim datResult As Date
    
    TA(1) = 0:    TA(2) = 30
    TA(3) = 60:    TA(4) = 89
    TA(5) = 119:    TA(6) = 148
    TA(7) = 178:    TA(8) = 207
    TA(9) = 237:    TA(10) = 266
    TA(11) = 296:    TA(12) = 325
    TA(13) = 355:    TA(14) = 384
    TA(15) = 414:    TA(16) = 443
    TA(17) = 473:    TA(18) = 502
    TA(19) = 532:    TA(20) = 562
    TA(21) = 591:    TA(22) = 621
    TA(23) = 650:    TA(24) = 680
    TA(25) = 709:    TA(26) = 739
    TA(27) = 768:    TA(28) = 798
    TA(29) = 827:    TA(30) = 857
    TA(31) = 886:    TA(32) = 916
    TA(33) = 945
    
    If cBulan < 3 Then
        intBulan = cBulan + 12
    Else
        intBulan = cBulan
    End If
    
    If intBulan < 3 Then
        intTahun = iTahun - 1
    Else
        intTahun = iTahun
    End If
    
    intAM1 = Int(365.25 * intTahun) + _
    Int(30.60001 * (intBulan + 1)) + cTanggal - 428
    
    If intAM1 < 577748 Then
        intKoreksiGr = 0
    Else
        intKoreksiGr = 2 - Int(intTahun / 100) + _
        Int(Int(intTahun / 100) / 4)
    End If
    
    intH = Int(365.25 * intTahun) + _
    Int(30.60001 * (intBulan + 1)) + cTanggal + _
    intKoreksiGr - 428
    
    intN = intH Mod 945
    
    If intN < 351 Then
        intI = (intN + 945) - 351
    Else
        intI = intN - 351
    End If
    
    For x = 1 To 33
        If TA(x) >= intI Then
            Ya = TA(x)
            Yb = TA(x - 1)
            Exit For
        End If
    Next
    
    datA1 = DateSerial(iTahun, 3, 31)
    datA2 = DateSerial(iTahun, 3, 2)
    
    Ma = Ya - intI + 1
    Mb = intI - Yb - 1
    
    MbMin = Mb + 1
    
    cDateFull = DateSerial(intTahun, intBulan, cTanggal)
    
    datMa = DateAdd("d", Ma - 1, cDateFull)
    datMb = DateAdd("d", -MbMin, cDateFull)
    
    lngMa = IIf(datMa >= datA1, 0, CLng(datMa))
    lngMb = IIf(datMb >= datA2, CLng(datMb), 0)
    
    intResult = lngMa + lngMb
    
    datResult = CDate(intResult)
    
    Nyepi = datResult
End Sub

- basBuddha

Option Explicit

Public Waisak As Date

Private Function iMod(dblValue1, dblValue2) As Double
On Error Resume Next
    iMod = dblValue1 - dblValue2 * Int(dblValue1 / dblValue2)
End Function

Private Function RoundDown(dblValue As Double) As Double
On Error GoTo PROC_ERR
Dim myDec As Long

myDec = InStr(1, CStr(dblValue), ".", vbTextCompare)
If myDec > 0 Then
    RoundDown = CDbl(Left(CStr(dblValue), myDec))
Else
    RoundDown = dblValue
End If

PROC_EXIT:
    Exit Function
PROC_ERR:
    MsgBox Err.Description, vbInformation, "Round Down"
End Function

Private Function RoundUp(dblValue As Double) As Double
On Error GoTo PROC_ERR
Dim myDec As Long

myDec = InStr(1, CStr(dblValue), ".", vbTextCompare)
If myDec > 0 Then
    RoundUp = CDbl(Left(CStr(dblValue), myDec)) + 1
Else
    RoundUp = dblValue
End If

PROC_EXIT:
    Exit Function
PROC_ERR:
    MsgBox Err.Description, vbInformation, "Round Up"
End Function

Private Function Trunc(dblValue As Double) As Long
On Error Resume Next
    Dim strValue As String
    
    If dblValue = 0 Then
        Trunc = 0
        Exit Function
    End If
    
    Dim myDec As Integer
    Dim Pisah() As String
    
    myDec = InStr(1, CStr(dblValue), ".", vbTextCompare)
    
    If myDec <> 0 Then
        Pisah = Split(CStr(dblValue), ".")
        strValue = Pisah(0)
    Else
        strValue = dblValue
    End If
    
    Trunc = CLng(strValue)
End Function

Public Sub Buddha(iTahun As Integer)
    Dim intIJST(1 To 2) As Integer
    Dim intTanggal(1 To 2) As Integer
    Dim intBulan(1 To 2) As Integer
    Dim intTahun(1 To 2) As Integer
    
    Dim intTa1(1 To 2) As Integer
    Dim intTa2(1 To 2) As Integer
    Dim intTa3(1 To 2) As Integer
    
    Const PI As Double = 3.141592654
    
    Dim dblKN(1 To 2) As Double
    Dim dblKB(1 To 2) As Double
    Dim dblT(1 To 2) As Double
    
    Dim dblK1(1 To 2) As Double
    Dim dblK2(1 To 2) As Double
    Dim dblK3(1 To 2) As Double
    Dim dblK4(1 To 2) As Double
    Dim dblK5(1 To 2) As Double
    Dim dblK6(1 To 2) As Double
    Dim dblK7(1 To 2) As Double
    
    Dim dblM(1 To 2) As Double
    Dim dblM1(1 To 2) As Double
    Dim dblM2(1 To 2) As Double
    Dim dblM3(1 To 2) As Double
    
    Dim dblMA(1 To 2) As Double
    Dim dblMA1(1 To 2) As Double
    Dim dblMA2(1 To 2) As Double
    Dim dblMA3(1 To 2) As Double
        
    Dim dblF(1 To 2) As Double
    Dim dblF1(1 To 2) As Double
    Dim dblF2(1 To 2) As Double
    Dim dblF3(1 To 2) As Double
    
    Dim dblKRA1(1 To 2) As Double
    Dim dblKRA2(1 To 2) As Double
    Dim dblKRA3(1 To 2) As Double
    Dim dblKRA4(1 To 2) As Double
    Dim dblKRA5(1 To 2) As Double
    Dim dblKRA6(1 To 2) As Double
    Dim dblKORA(1 To 2) As Double
    
    Dim dblKRB1(1 To 2) As Double
    Dim dblKRB2(1 To 2) As Double
    Dim dblKRB3(1 To 2) As Double
    Dim dblKRB4(1 To 2) As Double
    Dim dblKRB5(1 To 2) As Double
    Dim dblKORB(1 To 2) As Double
    Dim dblKORB1(1 To 2) As Double
    
    Dim dblKC1(1 To 2) As Double
    Dim dblKC2(1 To 2) As Double
    Dim dblKC3(1 To 2) As Double
    Dim dblKORC(1 To 2) As Double
    Dim dblKORC1(1 To 2) As Double
    
    Dim dblKoreksi(1 To 2) As Double
    
    Dim dblJdA1(1 To 2) As Double
    Dim dblJdA2(1 To 2) As Double
    Dim dblJdA3(1 To 2) As Double
    
    Dim dblJdB1(1 To 2) As Double
    Dim dblJdB2(1 To 2) As Double
    Dim dblJdB3(1 To 2) As Double
    
    Dim dblJdC1(1 To 2) As Double
    Dim dblJdC2(1 To 2) As Double
    Dim dblJdC3(1 To 2) As Double
    
    Dim dblJD(1 To 2) As Double
    
    Dim dblZJd(1 To 2) As Double
    Dim dblEFJd(1 To 2) As Double
    Dim dblAPJd(1 To 2) As Double
    Dim dblAJd(1 To 2) As Double
    Dim dblBJd(1 To 2) As Double
    Dim dblCJd(1 To 2) As Double
    Dim dblDJd(1 To 2) As Double
    Dim dblEJd(1 To 2) As Double
    
    Dim dblHasilJam(1 To 2) As Double
    Dim dblHasilBulan(1 To 2) As Integer
    Dim dblHasilTahun(1 To 2) As Integer
    Dim dblHasilHari(1 To 2) As Integer
    Dim dblHasilPasaran(1 To 2) As Integer
    
    Dim dblTgl1(1 To 2) As Double
    Dim dblTgl2(1 To 2) As Double
    Dim dblTgl3(1 To 2) As Double
    Dim dblTgl4(1 To 2) As Double
    Dim dblTgl5(1 To 2) As Double
    Dim dblTglM(1 To 2) As Double
    
    Dim dblKT(1 To 2) As Double
    Dim dblET1(1 To 2) As Double
    Dim dblET2(1 To 2) As Double
    Dim dblKET(1 To 2) As Double
    
    Dim dblJDH(1 To 2) As Double
    
    Dim datFull(1 To 2) As Date
    Dim datHasil(1 To 2) As Date
        
    intIJST(1) = 0
    intTanggal(1) = 5
    intBulan(1) = 5
    intTahun(1) = iTahun
    
    datFull(1) = DateSerial(intTahun(1), intBulan(1), intTanggal(1))
    
    intTa1(1) = IIf((intTahun(1) Mod 4) = 0, 1, 0)
    intTa2(1) = IIf((intTahun(1) Mod 100) = 0, 1, 0)
    intTa3(1) = intTa1(1) + intTa2(1)
    
    dblKB(1) = IIf(intTa3(1) > 0, 1, 2)
    
    dblK1(1) = Trunc((275 * intBulan(1)) / 9)
    dblK2(1) = Trunc((intBulan(1) + 9) / 12) * dblKB(1)
    dblK3(1) = (dblK1(1) - dblK2(1) + intTanggal(1) - 30)
    dblK4(1) = (dblK3(1) / 365.25) + (intTahun(1) - 1900)
    dblK5(1) = (dblK4(1) * 12.3685)
    dblK6(1) = (dblK5(1) - Trunc(dblK5(1)))
    dblK7(1) = IIf(dblK6(1) > 0.5, Trunc(dblK5(1) + 1), Trunc(dblK5(1) + 0))
    
    dblKN(1) = IIf(intIJST(1) = 1, (dblK7(1) - 0), (dblK7(1) - 0.5))
    dblT(1) = (dblKN(1) / 1236.85)
    
    dblM1(1) = 29.10535608 * dblKN(1)
    dblM2(1) = -0.000033 * dblT(1) * dblT(1)
    dblM3(1) = -0.00000347 * dblT(1) * dblT(1) * dblT(1)
    dblM(1) = iMod(359.2242 + dblM1(1) + dblM2(1) + dblM3(1), 360)
    
    dblMA1(1) = 385.81691806 * dblKN(1)
    dblMA2(1) = 0.0107306 * dblT(1) * dblT(1)
    dblMA3(1) = 0.00001236 * dblT(1) * dblT(1) * dblT(1)
    dblMA(1) = iMod(306.0253 + dblMA1(1) + dblMA2(1) + dblMA3(1), 360)
    
    dblF1(1) = 390.67050646 * dblKN(1)
    dblF2(1) = -0.0016528 * dblT(1) * dblT(1)
    dblF3(1) = -0.00000239 * dblT(1) * dblT(1) * dblT(1)
    dblF(1) = iMod(21.2964 + dblF1(1) + dblF2(1) + dblF3(1), 360)
    
    dblKRA1(1) = 0.1734 - (0.000393 * dblT(1))
    dblKRA2(1) = (dblKRA1(1) * Sin(dblM(1) * PI / 180))
    dblKRA3(1) = -0.4068 * Sin(dblMA(1) * PI / 180)
    dblKRA4(1) = 0.0021 * Sin(2 * dblM(1) * PI / 180)
    dblKRA5(1) = 0.0161 * Sin(2 * dblMA(1) * PI / 180)
    dblKRA6(1) = -0.0004 * Sin(3 * dblMA(1) * PI / 180)
    dblKORA(1) = (dblKRA2(1) + dblKRA3(1) + dblKRA4(1) + dblKRA5(1) + dblKRA6(1))
    
    dblKRB1(1) = -0.0051 * Sin((dblM(1) + dblMA(1)) * PI / 180)
    dblKRB2(1) = -0.0074 * Sin((dblM(1) - dblMA(1)) * PI / 180)
    dblKRB3(1) = 0.0004 * Sin((2 * dblF(1) + dblM(1)) * PI / 180)
    dblKRB4(1) = -0.0004 * Sin((2 * dblF(1) - dblM(1)) * PI / 180)
    dblKRB5(1) = 0.0104 * Sin(2 * dblF(1) * PI / 180)
    dblKORB(1) = (dblKRB1(1) + dblKRB2(1) + dblKRB3(1) + dblKRB4(1) + dblKRB5(1))
    dblKORB1(1) = -0.0051 * Sin((dblM(1) + dblMA(1)) * PI / 180) + _
                  -0.0074 * Sin((dblM(1) - dblMA(1)) * PI / 180) + _
                  0.0004 * Sin((2 * dblF(1) + dblM(1)) * PI / 180) + _
                  -0.0004 * Sin((2 * dblF(1) - dblM(1)) * PI / 180) + _
                  0.0104 * Sin(2 * dblF(1) * PI / 180)
    
    dblKC1(1) = -0.0006 * Sin((2 * dblF(1) + dblMA(1)) * PI / 180)
    dblKC2(1) = 0.001 * Sin((2 * dblF(1) - dblMA(1)) * PI / 180)
    dblKC3(1) = 0.0005 * Sin((dblM(1) + 2 * dblMA(1)) * PI / 180)
    dblKORC(1) = (dblKC1(1) + dblKC2(1) + dblKC3(1))
    dblKORC1(1) = -0.0006 * Sin((2 * dblF(1) + dblMA(1)) * PI / 180) + _
                  0.001 * Sin((2 * dblF(1) - dblMA(1)) * PI / 180) + _
                  0.0005 * Sin((dblM(1) + 2 * dblMA(1)) * PI / 180)
    
    dblKoreksi(1) = (dblKORA(1) + dblKORB(1) + dblKORC(1))
    
    dblJdA1(1) = 29.53058868 * dblKN(1)
    dblJdA2(1) = 0.0001178 * dblT(1) * dblT(1) * dblT(1)
    dblJdA3(1) = -0.000000155 * dblT(1) * dblT(1) * dblT(1)
    
    dblJdB1(1) = 132.87 * dblT(1)
    dblJdB2(1) = 0.009173 * dblT(1) * dblT(1)
    dblJdB3(1) = 166.56 + dblJdB1(1) - dblJdB2(1)
    
    dblJdC1(1) = 0.00033 * Sin(dblJdB3(1) * PI / 180)
    dblJdC2(1) = (dblJdA1(1) + dblJdA2(1) + dblJdA3(1) + dblJdC1(1))
    dblJdC3(1) = 2415020.75933 + dblJdC2(1)
    dblJD(1) = (dblJdC3(1) + 0.5 + dblKoreksi(1))
    
    dblZJd(1) = Trunc(dblJD(1))
    dblEFJd(1) = (dblJD(1) - dblZJd(1))
    dblAPJd(1) = Trunc((dblZJd(1) - 1867216.25) / 36524.25)
    dblAJd(1) = IIf(dblZJd(1) < 2299161, dblZJd(1), dblZJd(1) + 1 + dblAPJd(1) - Trunc(dblAPJd(1) / 4))
    dblBJd(1) = (dblAJd(1) + 1524)
    dblCJd(1) = Trunc((dblBJd(1) - 122.1) / 365.25)
    dblDJd(1) = Trunc(365.25 * dblCJd(1))
    dblEJd(1) = Trunc((dblBJd(1) - dblDJd(1)) / 30.6001)
    
    dblTgl1(1) = (dblBJd(1) - dblDJd(1) - Trunc(30.6001 * dblEJd(1)) + dblEFJd(1))
    dblTgl2(1) = Trunc(dblTgl1(1))
    dblTgl3(1) = (dblTgl1(1) - dblTgl2(1))
    dblTgl4(1) = (dblTgl3(1) * 24)
    dblTgl5(1) = (dblTgl4(1) + 7)
    dblTglM(1) = IIf(dblTgl5(1) <= 24, dblTgl2(1), dblTgl2(1) + 1)
    
    dblKT(1) = (dblK4(1) - 100) / 100
    dblET1(1) = 123.5 * dblKT(1)
    dblET2(1) = 32.5 * dblKT(1) * dblKT(1)
    dblKET(1) = (102.3 + dblET1(1) + dblET2(1)) / 3600
    
    dblJDH(1) = IIf(dblTgl5(1) <= 24, (dblZJd(1) + 2), dblZJd(1) + 3)
    
    dblHasilBulan(1) = IIf(dblEJd(1) < 13.5, dblEJd(1) - 1, dblEJd(1) - 13)
    dblHasilTahun(1) = IIf(dblHasilBulan(1) < 2.5, Trunc(dblCJd(1) - 4715), Trunc(dblCJd(1) - 4716))
    dblHasilHari(1) = (dblJDH(1) - Trunc(dblJDH(1) / 7) * 7)
    dblHasilPasaran(1) = (dblJDH(1) - Trunc(dblJDH(1) / 5) * 5)
    dblHasilJam(1) = IIf(dblTgl5(1) > 24, (dblTgl5(1) - 24), dblTgl5(1))
    
    
    'Tabel 2
    datHasil(1) = DateSerial(dblHasilTahun(1), dblHasilBulan(1), dblTglM(1))
    datFull(2) = IIf(datHasil(1) > datFull(1), datHasil(1), datHasil(1) + 29)
    
    intIJST(2) = 0
    intTanggal(2) = Day(datFull(2))
    intBulan(2) = Month(datFull(2))
    intTahun(2) = Year(datFull(2))
    
    intTa1(2) = IIf((intTahun(2) Mod 4) = 0, 1, 0)
    intTa2(2) = IIf((intTahun(2) Mod 100) = 0, 1, 0)
    intTa3(2) = intTa1(2) + intTa2(2)
    
    dblKB(2) = IIf(intTa3(2) > 0, 1, 2)
    
    '===========================================================================
    
    dblK1(2) = Trunc((275 * intBulan(2)) / 9)
    dblK2(2) = Trunc((intBulan(2) + 9) / 12) * dblKB(2)
    dblK3(2) = (dblK1(2) - dblK2(2) + intTanggal(2) - 30)
    dblK4(2) = (dblK3(2) / 365.25) + (intTahun(2) - 1900)
    dblK5(2) = (dblK4(2) * 12.3685)
    dblK6(2) = (dblK5(2) - Trunc(dblK5(2)))
    dblK7(2) = IIf(dblK6(2) > 0.5, Trunc(dblK5(2) + 1), Trunc(dblK5(2) + 0))
    
    dblKN(2) = IIf(intIJST(2) = 1, (dblK7(2) - 0), (dblK7(2) - 0.5))
    dblT(2) = (dblKN(2) / 1236.85)
    
    dblM1(2) = 29.10535608 * dblKN(2)
    dblM2(2) = -0.000033 * dblT(2) * dblT(2)
    dblM3(2) = -0.00000347 * dblT(2) * dblT(2) * dblT(2)
    dblM(2) = iMod(359.2242 + dblM1(2) + dblM2(2) + dblM3(2), 360)
    
    dblMA1(2) = 385.81691806 * dblKN(2)
    dblMA2(2) = 0.0107306 * dblT(2) * dblT(2)
    dblMA3(2) = 0.00001236 * dblT(2) * dblT(2) * dblT(2)
    dblMA(2) = iMod(306.0253 + dblMA1(2) + dblMA2(2) + dblMA3(2), 360)
    
    dblF1(2) = 390.67050646 * dblKN(2)
    dblF2(2) = -0.0016528 * dblT(2) * dblT(2)
    dblF3(2) = -0.00000239 * dblT(2) * dblT(2) * dblT(2)
    dblF(2) = iMod(21.2964 + dblF1(2) + dblF2(2) + dblF3(2), 360)
    
    dblKRA1(2) = 0.1734 - (0.000393 * dblT(2))
    dblKRA2(2) = (dblKRA1(2) * Sin(dblM(2) * PI / 180))
    dblKRA3(2) = -0.4068 * Sin(dblMA(2) * PI / 180)
    dblKRA4(2) = 0.0021 * Sin(2 * dblM(2) * PI / 180)
    dblKRA5(2) = 0.0161 * Sin(2 * dblMA(2) * PI / 180)
    dblKRA6(2) = -0.0004 * Sin(3 * dblMA(2) * PI / 180)
    dblKORA(2) = (dblKRA2(2) + dblKRA3(2) + dblKRA4(2) + dblKRA5(2) + dblKRA6(2))
    
    dblKRB1(2) = -0.0051 * Sin((dblM(2) + dblMA(2)) * PI / 180)
    dblKRB2(2) = -0.0074 * Sin((dblM(2) - dblMA(2)) * PI / 180)
    dblKRB3(2) = 0.0004 * Sin((2 * dblF(2) + dblM(2)) * PI / 180)
    dblKRB4(2) = -0.0004 * Sin((2 * dblF(2) - dblM(2)) * PI / 180)
    dblKRB5(2) = 0.0104 * Sin(2 * dblF(2) * PI / 180)
    dblKORB(2) = (dblKRB1(2) + dblKRB2(2) + dblKRB3(2) + dblKRB4(2) + dblKRB5(2))
    dblKORB1(2) = -0.0051 * Sin((dblM(2) + dblMA(2)) * PI / 180) + _
                  -0.0074 * Sin((dblM(2) - dblMA(2)) * PI / 180) + _
                  0.0004 * Sin((2 * dblF(2) + dblM(2)) * PI / 180) + _
                  -0.0004 * Sin((2 * dblF(2) - dblM(2)) * PI / 180) + _
                  0.0104 * Sin(2 * dblF(2) * PI / 180)
    
    dblKC1(2) = -0.0006 * Sin((2 * dblF(2) + dblMA(2)) * PI / 180)
    dblKC2(2) = 0.001 * Sin((2 * dblF(2) - dblMA(2)) * PI / 180)
    dblKC3(2) = 0.0005 * Sin((dblM(2) + 2 * dblMA(2)) * PI / 180)
    dblKORC(2) = (dblKC1(2) + dblKC2(2) + dblKC3(2))
    dblKORC1(2) = -0.0006 * Sin((2 * dblF(2) + dblMA(2)) * PI / 180) + _
                  0.001 * Sin((2 * dblF(2) - dblMA(2)) * PI / 180) + _
                  0.0005 * Sin((dblM(2) + 2 * dblMA(2)) * PI / 180)
    
    dblKoreksi(2) = (dblKORA(2) + dblKORB(2) + dblKORC(2))
    
    dblJdA1(2) = 29.53058868 * dblKN(2)
    dblJdA2(2) = 0.0001178 * dblT(2) * dblT(2) * dblT(2)
    dblJdA3(2) = -0.000000155 * dblT(2) * dblT(2) * dblT(2)
    
    dblJdB1(2) = 132.87 * dblT(2)
    dblJdB2(2) = 0.009173 * dblT(2) * dblT(2)
    dblJdB3(2) = 166.56 + dblJdB1(2) - dblJdB2(2)
    
    dblJdC1(2) = 0.00033 * Sin(dblJdB3(2) * PI / 180)
    dblJdC2(2) = (dblJdA1(2) + dblJdA2(2) + dblJdA3(2) + dblJdC1(2))
    dblJdC3(2) = 2415020.75933 + dblJdC2(2)
    dblJD(2) = (dblJdC3(2) + 0.5 + dblKoreksi(2))
    
    dblZJd(2) = Trunc(dblJD(2))
    dblEFJd(2) = (dblJD(2) - dblZJd(2))
    dblAPJd(2) = Trunc((dblZJd(2) - 1867216.25) / 36524.25)
    dblAJd(2) = IIf(dblZJd(2) < 2299161, dblZJd(2), dblZJd(2) + 1 + dblAPJd(2) - Trunc(dblAPJd(2) / 4))
    dblBJd(2) = (dblAJd(2) + 1524)
    dblCJd(2) = Trunc((dblBJd(2) - 122.1) / 365.25)
    dblDJd(2) = Trunc(365.25 * dblCJd(2))
    dblEJd(2) = Trunc((dblBJd(2) - dblDJd(2)) / 30.6001)
    
    dblTgl1(2) = (dblBJd(2) - dblDJd(2) - Trunc(30.6001 * dblEJd(2)) + dblEFJd(2))
    dblTgl2(2) = Trunc(dblTgl1(2))
    dblTgl3(2) = (dblTgl1(2) - dblTgl2(2))
    dblTgl4(2) = (dblTgl3(2) * 24)
    dblTgl5(2) = (dblTgl4(2) + 7)
    dblTglM(2) = IIf(dblTgl5(2) <= 24, dblTgl2(2), dblTgl2(2) + 1)
    
    dblKT(2) = (dblK4(2) - 100) / 100
    dblET1(2) = 123.5 * dblKT(2)
    dblET2(2) = 32.5 * dblKT(2) * dblKT(2)
    dblKET(2) = (102.3 + dblET1(2) + dblET2(2)) / 3600
    
    dblJDH(2) = IIf(dblTgl5(2) <= 24, (dblZJd(2) + 2), dblZJd(2) + 3)
    
    dblHasilBulan(2) = IIf(dblEJd(2) < 13.5, dblEJd(2) - 1, dblEJd(2) - 13)
    dblHasilTahun(2) = IIf(dblHasilBulan(2) < 2.5, Trunc(dblCJd(2) - 4715), Trunc(dblCJd(2) - 4716))
    dblHasilHari(2) = (dblJDH(2) - Trunc(dblJDH(2) / 7) * 7)
    dblHasilPasaran(2) = (dblJDH(2) - Trunc(dblJDH(2) / 5) * 5)
    dblHasilJam(2) = IIf(dblTgl5(2) > 24, (dblTgl5(2) - 24), dblTgl5(2))
    
    datHasil(2) = DateSerial(dblHasilTahun(2), dblHasilBulan(2), dblTglM(2))
    
    Waisak = datHasil(2)
End Sub

- basChina

Option Explicit

Public Imlek As Date
Public Shio As String

Private Function iMod(dblValue1, dblValue2) As Double
On Error Resume Next
    iMod = dblValue1 - dblValue2 * Int(dblValue1 / dblValue2)
End Function

Private Function RoundDown(dblValue As Double) As Double
On Error GoTo PROC_ERR
Dim myDec As Long

myDec = InStr(1, CStr(dblValue), ".", vbTextCompare)
If myDec > 0 Then
    RoundDown = CDbl(Left(CStr(dblValue), myDec))
Else
    RoundDown = dblValue
End If

PROC_EXIT:
    Exit Function
PROC_ERR:
    MsgBox Err.Description, vbInformation, "Round Down"
End Function

Private Function RoundUp(dblValue As Double) As Double
On Error GoTo PROC_ERR
Dim myDec As Long

myDec = InStr(1, CStr(dblValue), ".", vbTextCompare)
If myDec > 0 Then
    RoundUp = CDbl(Left(CStr(dblValue), myDec)) + 1
Else
    RoundUp = dblValue
End If

PROC_EXIT:
    Exit Function
PROC_ERR:
    MsgBox Err.Description, vbInformation, "Round Up"
End Function

Private Function Trunc(dblValue As Double) As Long
On Error Resume Next
    Dim strValue As String
    
    If dblValue = 0 Then
        Trunc = 0
        Exit Function
    End If
    
    Dim myDec As Integer
    Dim Pisah() As String
    
    myDec = InStr(1, CStr(dblValue), ".", vbTextCompare)
    
    If myDec <> 0 Then
        Pisah = Split(CStr(dblValue), ".")
        strValue = Pisah(0)
    Else
        strValue = dblValue
    End If
    
    Trunc = CLng(strValue)
End Function

Public Sub China(iTahun As Integer)
    Dim intIJST(1 To 2) As Integer
    Dim intTanggal(1 To 2) As Integer
    Dim intBulan(1 To 2) As Integer
    Dim intTahun(1 To 2) As Integer
    
    Dim intTa1(1 To 2) As Integer
    Dim intTa2(1 To 2) As Integer
    Dim intTa3(1 To 2) As Integer
    
    Const PI As Double = 3.141592654
    
    Dim dblKN(1 To 2) As Double
    Dim dblKB(1 To 2) As Double
    Dim dblT(1 To 2) As Double
    
    Dim dblK1(1 To 2) As Double
    Dim dblK2(1 To 2) As Double
    Dim dblK3(1 To 2) As Double
    Dim dblK4(1 To 2) As Double
    Dim dblK5(1 To 2) As Double
    Dim dblK6(1 To 2) As Double
    Dim dblK7(1 To 2) As Double
    
    Dim dblM(1 To 2) As Double
    Dim dblM1(1 To 2) As Double
    Dim dblM2(1 To 2) As Double
    Dim dblM3(1 To 2) As Double
    
    Dim dblMA(1 To 2) As Double
    Dim dblMA1(1 To 2) As Double
    Dim dblMA2(1 To 2) As Double
    Dim dblMA3(1 To 2) As Double
        
    Dim dblF(1 To 2) As Double
    Dim dblF1(1 To 2) As Double
    Dim dblF2(1 To 2) As Double
    Dim dblF3(1 To 2) As Double
    
    Dim dblKRA1(1 To 2) As Double
    Dim dblKRA2(1 To 2) As Double
    Dim dblKRA3(1 To 2) As Double
    Dim dblKRA4(1 To 2) As Double
    Dim dblKRA5(1 To 2) As Double
    Dim dblKRA6(1 To 2) As Double
    Dim dblKORA(1 To 2) As Double
    
    Dim dblKRB1(1 To 2) As Double
    Dim dblKRB2(1 To 2) As Double
    Dim dblKRB3(1 To 2) As Double
    Dim dblKRB4(1 To 2) As Double
    Dim dblKRB5(1 To 2) As Double
    Dim dblKORB(1 To 2) As Double
    Dim dblKORB1(1 To 2) As Double
    
    Dim dblKC1(1 To 2) As Double
    Dim dblKC2(1 To 2) As Double
    Dim dblKC3(1 To 2) As Double
    Dim dblKORC(1 To 2) As Double
    Dim dblKORC1(1 To 2) As Double
    
    Dim dblKoreksi(1 To 2) As Double
    
    Dim dblJdA1(1 To 2) As Double
    Dim dblJdA2(1 To 2) As Double
    Dim dblJdA3(1 To 2) As Double
    
    Dim dblJdB1(1 To 2) As Double
    Dim dblJdB2(1 To 2) As Double
    Dim dblJdB3(1 To 2) As Double
    
    Dim dblJdC1(1 To 2) As Double
    Dim dblJdC2(1 To 2) As Double
    Dim dblJdC3(1 To 2) As Double
    
    Dim dblJD(1 To 2) As Double
    
    Dim dblZJd(1 To 2) As Double
    Dim dblEFJd(1 To 2) As Double
    Dim dblAPJd(1 To 2) As Double
    Dim dblAJd(1 To 2) As Double
    Dim dblBJd(1 To 2) As Double
    Dim dblCJd(1 To 2) As Double
    Dim dblDJd(1 To 2) As Double
    Dim dblEJd(1 To 2) As Double
    
    Dim dblHasilJam(1 To 2) As Double
    Dim dblHasilBulan(1 To 2) As Integer
    Dim dblHasilTahun(1 To 2) As Integer
    Dim dblHasilHari(1 To 2) As Integer
    Dim dblHasilPasaran(1 To 2) As Integer
    
    Dim dblTgl1(1 To 2) As Double
    Dim dblTgl2(1 To 2) As Double
    Dim dblTgl3(1 To 2) As Double
    Dim dblTgl4(1 To 2) As Double
    Dim dblTgl5(1 To 2) As Double
    Dim dblTglM(1 To 2) As Double
    
    Dim dblKT(1 To 2) As Double
    Dim dblET1(1 To 2) As Double
    Dim dblET2(1 To 2) As Double
    Dim dblKET(1 To 2) As Double
    
    Dim dblJDH(1 To 2) As Double
    
    Dim datFull(1 To 2) As Date
    Dim datHasil(1 To 2) As Date
        
    intIJST(1) = 1
    intTanggal(1) = 22
    intBulan(1) = 12
    intTahun(1) = iTahun - 1
    
    datFull(1) = DateSerial(intTahun(1), intBulan(1), intTanggal(1))
    
    intTa1(1) = IIf((intTahun(1) Mod 4) = 0, 1, 0)
    intTa2(1) = IIf((intTahun(1) Mod 100) = 0, 1, 0)
    intTa3(1) = intTa1(1) + intTa2(1)
    
    dblKB(1) = IIf(intTa3(1) > 0, 1, 2)
    
    dblK1(1) = Trunc((275 * intBulan(1)) / 9)
    dblK2(1) = Trunc((intBulan(1) + 9) / 12) * dblKB(1)
    dblK3(1) = (dblK1(1) - dblK2(1) + intTanggal(1) - 30)
    dblK4(1) = (dblK3(1) / 365.25) + (intTahun(1) - 1900)
    dblK5(1) = (dblK4(1) * 12.3685)
    dblK6(1) = (dblK5(1) - Trunc(dblK5(1)))
    dblK7(1) = IIf(dblK6(1) > 0.5, Trunc(dblK5(1) + 1), Trunc(dblK5(1) + 0))
    
    dblKN(1) = IIf(intIJST(1) = 1, (dblK7(1) - 0), (dblK7(1) - 0.5))
    dblT(1) = (dblKN(1) / 1236.85)
    
    dblM1(1) = 29.10535608 * dblKN(1)
    dblM2(1) = -0.000033 * dblT(1) * dblT(1)
    dblM3(1) = -0.00000347 * dblT(1) * dblT(1) * dblT(1)
    dblM(1) = iMod(359.2242 + dblM1(1) + dblM2(1) + dblM3(1), 360)
    
    dblMA1(1) = 385.81691806 * dblKN(1)
    dblMA2(1) = 0.0107306 * dblT(1) * dblT(1)
    dblMA3(1) = 0.00001236 * dblT(1) * dblT(1) * dblT(1)
    dblMA(1) = iMod(306.0253 + dblMA1(1) + dblMA2(1) + dblMA3(1), 360)
    
    dblF1(1) = 390.67050646 * dblKN(1)
    dblF2(1) = -0.0016528 * dblT(1) * dblT(1)
    dblF3(1) = -0.00000239 * dblT(1) * dblT(1) * dblT(1)
    dblF(1) = iMod(21.2964 + dblF1(1) + dblF2(1) + dblF3(1), 360)
    
    dblKRA1(1) = 0.1734 - (0.000393 * dblT(1))
    dblKRA2(1) = (dblKRA1(1) * Sin(dblM(1) * PI / 180))
    dblKRA3(1) = -0.4068 * Sin(dblMA(1) * PI / 180)
    dblKRA4(1) = 0.0021 * Sin(2 * dblM(1) * PI / 180)
    dblKRA5(1) = 0.0161 * Sin(2 * dblMA(1) * PI / 180)
    dblKRA6(1) = -0.0004 * Sin(3 * dblMA(1) * PI / 180)
    dblKORA(1) = (dblKRA2(1) + dblKRA3(1) + dblKRA4(1) + dblKRA5(1) + dblKRA6(1))
    
    dblKRB1(1) = -0.0051 * Sin((dblM(1) + dblMA(1)) * PI / 180)
    dblKRB2(1) = -0.0074 * Sin((dblM(1) - dblMA(1)) * PI / 180)
    dblKRB3(1) = 0.0004 * Sin((2 * dblF(1) + dblM(1)) * PI / 180)
    dblKRB4(1) = -0.0004 * Sin((2 * dblF(1) - dblM(1)) * PI / 180)
    dblKRB5(1) = 0.0104 * Sin(2 * dblF(1) * PI / 180)
    dblKORB(1) = (dblKRB1(1) + dblKRB2(1) + dblKRB3(1) + dblKRB4(1) + dblKRB5(1))
    dblKORB1(1) = -0.0051 * Sin((dblM(1) + dblMA(1)) * PI / 180) + _
                  -0.0074 * Sin((dblM(1) - dblMA(1)) * PI / 180) + _
                  0.0004 * Sin((2 * dblF(1) + dblM(1)) * PI / 180) + _
                  -0.0004 * Sin((2 * dblF(1) - dblM(1)) * PI / 180) + _
                  0.0104 * Sin(2 * dblF(1) * PI / 180)
    
    dblKC1(1) = -0.0006 * Sin((2 * dblF(1) + dblMA(1)) * PI / 180)
    dblKC2(1) = 0.001 * Sin((2 * dblF(1) - dblMA(1)) * PI / 180)
    dblKC3(1) = 0.0005 * Sin((dblM(1) + 2 * dblMA(1)) * PI / 180)
    dblKORC(1) = (dblKC1(1) + dblKC2(1) + dblKC3(1))
    dblKORC1(1) = -0.0006 * Sin((2 * dblF(1) + dblMA(1)) * PI / 180) + _
                  0.001 * Sin((2 * dblF(1) - dblMA(1)) * PI / 180) + _
                  0.0005 * Sin((dblM(1) + 2 * dblMA(1)) * PI / 180)
    
    dblKoreksi(1) = (dblKORA(1) + dblKORB(1) + dblKORC(1))
    
    dblJdA1(1) = 29.53058868 * dblKN(1)
    dblJdA2(1) = 0.0001178 * dblT(1) * dblT(1) * dblT(1)
    dblJdA3(1) = -0.000000155 * dblT(1) * dblT(1) * dblT(1)
    
    dblJdB1(1) = 132.87 * dblT(1)
    dblJdB2(1) = 0.009173 * dblT(1) * dblT(1)
    dblJdB3(1) = 166.56 + dblJdB1(1) - dblJdB2(1)
    
    dblJdC1(1) = 0.00033 * Sin(dblJdB3(1) * PI / 180)
    dblJdC2(1) = (dblJdA1(1) + dblJdA2(1) + dblJdA3(1) + dblJdC1(1))
    dblJdC3(1) = 2415020.75933 + dblJdC2(1)
    dblJD(1) = (dblJdC3(1) + 0.5 + dblKoreksi(1))
    
    dblZJd(1) = Trunc(dblJD(1))
    dblEFJd(1) = (dblJD(1) - dblZJd(1))
    dblAPJd(1) = Trunc((dblZJd(1) - 1867216.25) / 36524.25)
    dblAJd(1) = IIf(dblZJd(1) < 2299161, dblZJd(1), _
    dblZJd(1) + 1 + dblAPJd(1) - Trunc(dblAPJd(1) / 4))
    
    dblBJd(1) = (dblAJd(1) + 1524)
    dblCJd(1) = Trunc((dblBJd(1) - 122.1) / 365.25)
    dblDJd(1) = Trunc(365.25 * dblCJd(1))
    dblEJd(1) = Trunc((dblBJd(1) - dblDJd(1)) / 30.6001)
    
    dblTgl1(1) = (dblBJd(1) - dblDJd(1) - Trunc(30.6001 * dblEJd(1)) + dblEFJd(1))
    dblTgl2(1) = Trunc(dblTgl1(1))
    dblTgl3(1) = (dblTgl1(1) - dblTgl2(1))
    dblTgl4(1) = (dblTgl3(1) * 24)
    dblTgl5(1) = (dblTgl4(1) + 7)
    dblTglM(1) = IIf(dblTgl5(1) <= 24, dblTgl2(1), dblTgl2(1) + 1)
    
    dblKT(1) = (dblK4(1) - 100) / 100
    dblET1(1) = 123.5 * dblKT(1)
    dblET2(1) = 32.5 * dblKT(1) * dblKT(1)
    dblKET(1) = (102.3 + dblET1(1) + dblET2(1)) / 3600
    
    dblJDH(1) = IIf(dblTgl5(1) <= 24, (dblZJd(1) + 2), dblZJd(1) + 3)
    
    dblHasilBulan(1) = IIf(dblEJd(1) < 13.5, dblEJd(1) - 1, dblEJd(1) - 13)
    dblHasilTahun(1) = IIf(dblHasilBulan(1) < 2.5, _
    Trunc(dblCJd(1) - 4715), Trunc(dblCJd(1) - 4716))
    
    dblHasilHari(1) = (dblJDH(1) - Trunc(dblJDH(1) / 7) * 7)
    dblHasilPasaran(1) = (dblJDH(1) - Trunc(dblJDH(1) / 5) * 5)
    dblHasilJam(1) = IIf(dblTgl5(1) > 24, (dblTgl5(1) - 24), dblTgl5(1))
    
    
    'Tabel 2
    datHasil(1) = DateSerial(dblHasilTahun(1), dblHasilBulan(1), dblTglM(1))
    datFull(2) = IIf(datHasil(1) > datFull(1), datHasil(1) + 29, datHasil(1) + (29 * 2))
    '
    intIJST(2) = 1
    intTanggal(2) = Day(datFull(2))
    intBulan(2) = Month(datFull(2))
    intTahun(2) = Year(datFull(2))
    
    intTa1(2) = IIf((intTahun(2) Mod 4) = 0, 1, 0)
    intTa2(2) = IIf((intTahun(2) Mod 100) = 0, 1, 0)
    intTa3(2) = intTa1(2) + intTa2(2)
    
    dblKB(2) = IIf(intTa3(2) > 0, 1, 2)
    
    '===========================================================================
    
    dblK1(2) = Trunc((275 * intBulan(2)) / 9)
    dblK2(2) = Trunc((intBulan(2) + 9) / 12) * dblKB(2)
    dblK3(2) = (dblK1(2) - dblK2(2) + intTanggal(2) - 30)
    dblK4(2) = (dblK3(2) / 365.25) + (intTahun(2) - 1900)
    dblK5(2) = (dblK4(2) * 12.3685)
    dblK6(2) = (dblK5(2) - Trunc(dblK5(2)))
    dblK7(2) = IIf(dblK6(2) > 0.5, Trunc(dblK5(2) + 1), Trunc(dblK5(2) + 0))
    
    dblKN(2) = IIf(intIJST(2) = 1, (dblK7(2) - 0), (dblK7(2) - 0.5))
    dblT(2) = (dblKN(2) / 1236.85)
    
    dblM1(2) = 29.10535608 * dblKN(2)
    dblM2(2) = -0.000033 * dblT(2) * dblT(2)
    dblM3(2) = -0.00000347 * dblT(2) * dblT(2) * dblT(2)
    dblM(2) = iMod(359.2242 + dblM1(2) + dblM2(2) + dblM3(2), 360)
    
    dblMA1(2) = 385.81691806 * dblKN(2)
    dblMA2(2) = 0.0107306 * dblT(2) * dblT(2)
    dblMA3(2) = 0.00001236 * dblT(2) * dblT(2) * dblT(2)
    dblMA(2) = iMod(306.0253 + dblMA1(2) + dblMA2(2) + dblMA3(2), 360)
    
    dblF1(2) = 390.67050646 * dblKN(2)
    dblF2(2) = -0.0016528 * dblT(2) * dblT(2)
    dblF3(2) = -0.00000239 * dblT(2) * dblT(2) * dblT(2)
    dblF(2) = iMod(21.2964 + dblF1(2) + dblF2(2) + dblF3(2), 360)
    
    dblKRA1(2) = 0.1734 - (0.000393 * dblT(2))
    dblKRA2(2) = (dblKRA1(2) * Sin(dblM(2) * PI / 180))
    dblKRA3(2) = -0.4068 * Sin(dblMA(2) * PI / 180)
    dblKRA4(2) = 0.0021 * Sin(2 * dblM(2) * PI / 180)
    dblKRA5(2) = 0.0161 * Sin(2 * dblMA(2) * PI / 180)
    dblKRA6(2) = -0.0004 * Sin(3 * dblMA(2) * PI / 180)
    dblKORA(2) = (dblKRA2(2) + dblKRA3(2) + dblKRA4(2) + dblKRA5(2) + dblKRA6(2))
    
    dblKRB1(2) = -0.0051 * Sin((dblM(2) + dblMA(2)) * PI / 180)
    dblKRB2(2) = -0.0074 * Sin((dblM(2) - dblMA(2)) * PI / 180)
    dblKRB3(2) = 0.0004 * Sin((2 * dblF(2) + dblM(2)) * PI / 180)
    dblKRB4(2) = -0.0004 * Sin((2 * dblF(2) - dblM(2)) * PI / 180)
    dblKRB5(2) = 0.0104 * Sin(2 * dblF(2) * PI / 180)
    dblKORB(2) = (dblKRB1(2) + dblKRB2(2) + dblKRB3(2) + dblKRB4(2) + dblKRB5(2))
    dblKORB1(2) = -0.0051 * Sin((dblM(2) + dblMA(2)) * PI / 180) + _
                  -0.0074 * Sin((dblM(2) - dblMA(2)) * PI / 180) + _
                  0.0004 * Sin((2 * dblF(2) + dblM(2)) * PI / 180) + _
                  -0.0004 * Sin((2 * dblF(2) - dblM(2)) * PI / 180) + _
                  0.0104 * Sin(2 * dblF(2) * PI / 180)
    
    dblKC1(2) = -0.0006 * Sin((2 * dblF(2) + dblMA(2)) * PI / 180)
    dblKC2(2) = 0.001 * Sin((2 * dblF(2) - dblMA(2)) * PI / 180)
    dblKC3(2) = 0.0005 * Sin((dblM(2) + 2 * dblMA(2)) * PI / 180)
    dblKORC(2) = (dblKC1(2) + dblKC2(2) + dblKC3(2))
    dblKORC1(2) = -0.0006 * Sin((2 * dblF(2) + dblMA(2)) * PI / 180) + _
                  0.001 * Sin((2 * dblF(2) - dblMA(2)) * PI / 180) + _
                  0.0005 * Sin((dblM(2) + 2 * dblMA(2)) * PI / 180)
    
    dblKoreksi(2) = (dblKORA(2) + dblKORB(2) + dblKORC(2))
    
    dblJdA1(2) = 29.53058868 * dblKN(2)
    dblJdA2(2) = 0.0001178 * dblT(2) * dblT(2) * dblT(2)
    dblJdA3(2) = -0.000000155 * dblT(2) * dblT(2) * dblT(2)
    
    dblJdB1(2) = 132.87 * dblT(2)
    dblJdB2(2) = 0.009173 * dblT(2) * dblT(2)
    dblJdB3(2) = 166.56 + dblJdB1(2) - dblJdB2(2)
    
    dblJdC1(2) = 0.00033 * Sin(dblJdB3(2) * PI / 180)
    dblJdC2(2) = (dblJdA1(2) + dblJdA2(2) + dblJdA3(2) + dblJdC1(2))
    dblJdC3(2) = 2415020.75933 + dblJdC2(2)
    dblJD(2) = (dblJdC3(2) + 0.5 + dblKoreksi(2))
    
    dblZJd(2) = Trunc(dblJD(2))
    dblEFJd(2) = (dblJD(2) - dblZJd(2))
    dblAPJd(2) = Trunc((dblZJd(2) - 1867216.25) / 36524.25)
    dblAJd(2) = IIf(dblZJd(2) < 2299161, dblZJd(2), _
    dblZJd(2) + 1 + dblAPJd(2) - Trunc(dblAPJd(2) / 4))
    
    dblBJd(2) = (dblAJd(2) + 1524)
    dblCJd(2) = Trunc((dblBJd(2) - 122.1) / 365.25)
    dblDJd(2) = Trunc(365.25 * dblCJd(2))
    dblEJd(2) = Trunc((dblBJd(2) - dblDJd(2)) / 30.6001)
    
    dblTgl1(2) = (dblBJd(2) - dblDJd(2) - Trunc(30.6001 * dblEJd(2)) + dblEFJd(2))
    dblTgl2(2) = Trunc(dblTgl1(2))
    dblTgl3(2) = (dblTgl1(2) - dblTgl2(2))
    dblTgl4(2) = (dblTgl3(2) * 24)
    dblTgl5(2) = (dblTgl4(2) + 7)
    dblTglM(2) = IIf(dblTgl5(2) <= 24, dblTgl2(2), dblTgl2(2) + 1)
    
    dblKT(2) = (dblK4(2) - 100) / 100
    dblET1(2) = 123.5 * dblKT(2)
    dblET2(2) = 32.5 * dblKT(2) * dblKT(2)
    dblKET(2) = (102.3 + dblET1(2) + dblET2(2)) / 3600
    
    dblJDH(2) = IIf(dblTgl5(2) <= 24, (dblZJd(2) + 2), dblZJd(2) + 3)
    
    dblHasilBulan(2) = IIf(dblEJd(2) < 13.5, dblEJd(2) - 1, dblEJd(2) - 13)
    dblHasilTahun(2) = IIf(dblHasilBulan(2) < 2.5, _
    Trunc(dblCJd(2) - 4715), Trunc(dblCJd(2) - 4716))
    
    dblHasilHari(2) = (dblJDH(2) - Trunc(dblJDH(2) / 7) * 7)
    dblHasilPasaran(2) = (dblJDH(2) - Trunc(dblJDH(2) / 5) * 5)
    dblHasilJam(2) = IIf(dblTgl5(2) > 24, (dblTgl5(2) - 24), dblTgl5(2))
    
    datHasil(2) = DateSerial(dblHasilTahun(2), dblHasilBulan(2), dblTglM(2))
    
    Imlek = datHasil(2)
    
    Dim strShio(0 To 11) As String
    Dim intShio As Integer
    
    strShio(0) = "Ayam"
    strShio(1) = "Anjing"
    strShio(2) = "Babi"
    strShio(3) = "Tikus"
    strShio(4) = "Kerbau"
    strShio(5) = "Harimau"
    strShio(6) = "Kelinci"
    strShio(7) = "Naga"
    strShio(8) = "Ular"
    strShio(9) = "Kuda"
    strShio(10) = "Kambing"
    strShio(11) = "Monyet"
    
    intShio = (iTahun + 551) Mod 12
    Shio = strShio(intShio)
End Sub

- basNasional

Option Explicit

Public Proklamasi As Date

Sub Nasional(intTahun As Integer)
    Proklamasi = DateSerial(intTahun, 8, 17)
End Sub

Bagaimana cara pengujiannya? Gampang, pada Form1, tambahkan sebuah CommandButton, lalu ketik kode di bawah ini:

Option Explicit

Private Sub Command1_Click()
    Dim intYear As Integer
    intYear = Year(Date)

    Call Kristen(intYear)
    Call Hindu(intYear)
    Call Buddha(intYear)
    Call China(intYear)
    Call Islam(intYear)

    Dim strPesan As String

    strPesan = "Tahun: " & intYear & vbCrLf
    strPesan = strPesan & String(25, "=") & vbCrLf & vbCrLf
               
    strPesan = strPesan & "Maulid Nabi Muhammad: " & _
               Format(MaulidNabi, "d MMM yyyy") & vbCrLf
    strPesan = strPesan & "Isra' Mi'raj Nabi Muhammad: " & _
               Format(IsraMiraj, "d MMM yyyy") & vbCrLf
    strPesan = strPesan & "Idul Fitri: " & _
               Format(IdulFitri, "d MMM yyyy") & vbCrLf
    strPesan = strPesan & "Idul Adha: " & _
               Format(IdulAdha, "d MMM yyyy") & vbCrLf
    strPesan = strPesan & "Tahun Baru Hijriyah: " & _
               Format(TahunBaruHijri, "d MMM yyyy") & vbCrLf & vbCrLf
               
    strPesan = strPesan & "Wafat Isa Al Masih: " & _
               Format(WafatIsa, "d MMM yyyy") & vbCrLf
    strPesan = strPesan & "Kenaikan Isa Al Masih: " & _
               Format(KenaikanIsa, "d MMM yyyy") & vbCrLf
    strPesan = strPesan & "Natal: " & _
               Format(Natal, "d MMM yyyy") & vbCrLf
    strPesan = strPesan & "Tahun Baru: " & _
               Format(TahunBaru, "d MMM yyyy") & vbCrLf & vbCrLf
               
    strPesan = strPesan & "Nyepi: " & _
               Format(Nyepi, "d MMM yyyy") & vbCrLf & vbCrLf
               
    strPesan = strPesan & "Waisak: " & _
               Format(Waisak, "d MMM yyyy") & vbCrLf & vbCrLf
               
    strPesan = strPesan & "Imlek: " & _
               Format(Imlek, "d MMM yyyy") & _
               " (" & Shio & ")" & vbCrLf & vbCrLf

    MsgBox strPesan, vbInformation, "Kalender"
End Sub

Hasil

Nah, selanjutnya tinggal mendayagunakan kemampuan Anda untuk menjadikan aplikasi lain sesuai kebutuhan Anda.

Perhatian:

Kode sumber di atas hanya boleh digunakan untuk keperluan non profit (untuk keperluan ini, harus menyertakan alamat blog http://www.pujanggavb.wordpress.com sebagai sumber referensi). Untuk keperluan komersial, harus menghubungi saya melalui email ke: pujanggabageur@yahoo.com.

About these ads

Perihal Novian Agung
Pengangguran

4 Responses to Menghitung Hari Libur Keagamaan

  1. Zulkifli Rahman mengatakan:

    thanks infonya..akan saya coba kodenya

  2. Vita mengatakan:

    kalau cuma pengen menampilkan tgl-bulan-dan thn hijriahnya saja gimana (semacam konversi)? umpama masehi tgl 04 nov 2012, hijriah 19 Dzulhijjah 1433.

  3. Fadhly mengatakan:

    Mantap.. :D
    I love coding..

  4. cicon mengatakan:

    untuk 2014 hari Nyepi dan waisaknya tidak sesuai

Tinggalkan Balasan

Isikan data di bawah atau klik salah satu ikon untuk log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Logout / Ubah )

Twitter picture

You are commenting using your Twitter account. Logout / Ubah )

Facebook photo

You are commenting using your Facebook account. Logout / Ubah )

Google+ photo

You are commenting using your Google+ account. Logout / Ubah )

Connecting to %s

Ikuti

Get every new post delivered to your Inbox.

%d bloggers like this: