VBA Tipp: Julianisches Datum ermitteln, Kalenderkonvertierungen, u.a.m.
Aus DBWiki
Inhaltsverzeichnis
Anforderung
Ich will mit dem in der Astronomie gebräuchlichen Julianischen Datum (beginnend mit dem 1. Januar 4713 v. Chr. 12 Uhr) arbeiten, sowie Konvertierungen eines Datums zwischen Julianischem Kalender, iki/Gregorianischer_Kalender Gregorianischem Kalender, des Islamischem Kalender und Jüdischem Kalenders vornehmen.
Lösung
Jean Meeus hat in seinem Buch Astronomical Algorithms ein entsprechendes Formelwerk veröffentlicht, das im folgenden VBA-Modul umgesetzt ist. An einigen Stellen wird von der Funktion Modf() Gebrauch gemacht, die man deshalb für die Verwendung des nachfolgenden Codes auch benötigt.
'Quelle: http://www.dbwiki.net/ ' 'Das Formelwerk stammt überwiegend aus 'Astronomical Algorithms' 2. Aufl., 'von Jean Meeus - in Kommentaren als AA abgekürzt. ' 'Geklmmerte Zahlen verweisen auf Kapitel und Formelnummer. ' Option Explicit '------------------------------------------------------------------------------ 'CalendarGregorianToJD konvertiert ein gregorianisches Jahr, Monat und Tag des 'Monats in einen Julianischen Tag. ' 'Negative Jahre sind gültig, bis auf JD 0, das Ergebnis ist nicht gültig für 'Daten vor JD 0. Public Function CalendarGregorianToJD(ByVal y As Long, ByVal m As Long, _ ByVal d As Double) As Double Dim a As Long Dim b As Long Select Case m Case 1, 2: y = y - 1: m = m + 12 End Select a = Int(y / 100) b = 2 - a + Int(a / 4) 'AA (7.1), S.61 CalendarGregorianToJD = Int(365.25 * (y + 4716)) _ + Int(30.6 * (m + 1)) + b + d - 1524.5 End Function '------------------------------------------------------------------------------ '------------------------------------------------------------------------------ 'CalendarJulianToJD konvertiert ein Julianisches Jahr, Monat und Tag des Monats 'in einen Julianischen Tag. ' 'Negative Jahre sind gültig, bis JD 0, das Ergebnis ist nicht gültig für Daten 'vor JD 0. Public Function CalendarJulianToJD(ByVal y As Long, ByVal m As Long, _ ByVal d As Double) As Double Select Case m Case 1, 2: y = y - 1: m = m + 12 End Select 'wie in CalendarGregorianToJD, nur dass b entfällt CalendarJulianToJD = Int(365.25 * (y + 4716)) _ + Int(30.6 * (m + 1)) + d - 1524.5 End Function '------------------------------------------------------------------------------ '------------------------------------------------------------------------------ 'LeapYearJulian gibt true zurück, wenn das Jahr y im Julianischen Kalender ein 'Schaltjahr ist. Public Function LeapYearJulian(ByVal y As Long) As Boolean 'AA S.62 LeapYearJulian = y Mod 4 = 0 End Function '------------------------------------------------------------------------------ '------------------------------------------------------------------------------ 'LeapYearGregorian gibt true zurück, wenn das Jahr y im Gregorianischen 'Kalender ein Schaltjahr ist. Public Function LeapYearGregorian(ByVal y As Long) As Boolean 'AA S.62 LeapYearGregorian = (y Mod 4 = 0 And y Mod 100 <> 0) Or (y Mod 400 = 0) End Function '------------------------------------------------------------------------------ '------------------------------------------------------------------------------ 'JDtoCalendar liefert das Kalenderdatum für das angegebene jd. ' 'Hinweis: Diese Methode gibt ein Datum im Julianischen oder ' Gregorianischen Kalender zurück. Public Sub JDtoCalendar(ByVal jd As Double, ByRef y As Long, _ ByRef m As Long, ByRef d As Double) Dim f As Double Dim zf As Double Dim z As Long Dim a As Long Dim alpha As Long Dim b As Long Dim c As Long Dim d_ As Long Dim e As Long 'AA S.63 f = Modf(jd + 0.5, zf) z = zf a = z If z >= 2299151 Then 'erstes Datum nach der gregorianischen Kalenderreform alpha = Int((z - 1867216.25) / 36524.25) a = z + 1 + alpha - Int(alpha / 4) End If b = a + 1524 c = Int((b - 122.1) / 365.25) d_ = Int(365.25 * c) e = Int((b - d_) / 30.6001) d = b - d_ - Int(30.6001 * e) + f Select Case e Case 14, 15: m = e - 13 Case Else: m = e - 1 End Select Select Case m Case 1, 2: y = c - 4715 Case Else: y = c - 4716 End Select End Sub '------------------------------------------------------------------------------ '------------------------------------------------------------------------------ 'JDtoCalendarGregorian gibt das Gregorianische Kalenderdatum für das angegebene 'JD zurück. 'Hinweis: Es wird ein Gregorianisches Datum auch für Daten vor dem Beginn des ' Gregorianischen Kalenders zurückgegeben. Die Funktion ist nützlich ' bei der Arbeit mit VBA Date Werten, weil diese immer auf dem ' Gregorianischen Kalender basieren. Public Sub JDtoCalendarGregorian(ByVal jd As Double, ByRef y As Long, _ ByRef m As Long, ByRef d As Double) Dim f As Double Dim zf As Double Dim z As Long Dim alpha As Long Dim a As Long Dim b As Long Dim c As Long Dim d_ As Long Dim e As Long 'AA S.63 f = Modf(jd + 0.5, zf) z = zf alpha = Int((z - 1867216.25) / 36524.25) a = z + 1 + alpha - Int(alpha / 4) b = a + 1524 c = Int((b - 122.1) / 365.25) d_ = Int(365.25 * c) e = Int((b - d_) / 30.6001) d = b - d_ - Int(30.6001 * e) + f Select Case e Case 14, 15: m = e - 13 Case Else: m = e - 1 End Select Select Case m Case 1, 2: y = c - 4715 Case Else: y = c - 4716 End Select End Sub '------------------------------------------------------------------------------ '------------------------------------------------------------------------------ 'JDtoDate wandelt ein Julianisches Datum in einen VBA-Datumswert. ' 'Die Zeit ist als UTC zu betrachten. Public Function JDtoDate(ByVal jd As Double) As Date Dim y As Long Dim m As Long Dim d As Double Dim f As Double JDtoCalendarGregorian jd, y, m, d If y < 100 Or Year > 9999 Then _ Err.Raise 6, , "Datumsbereich ist zu klein oder zu groß." f = Modf(d, d) JDtoDate = DateSerial(y, m, d) + CDate(f) End Function '------------------------------------------------------------------------------ '------------------------------------------------------------------------------ 'DatetoJD wandelt ein VBA-Datum in ein Julianisches Datum um. ' 'Die Zeit wird als UTC behandelt. Public Function DatetoJD(ByVal dt As Date) As Double DatetoJD = CalendarGregorianToJD(Year(dt), Month(dt), day(dt) + TimeValue(dt)) End Function '------------------------------------------------------------------------------ '------------------------------------------------------------------------------ 'DayOfWeek bestimmt den Wochentag für ein bestimmtes JD. ' 'Der zurückgegebene Wert ist eine ganze Zahl im Bereich von 0 bis 6, 'wobei 0 für Sonntag steht. Dies ist die gleiche Konvention wie im 'VBA DateTime Modul. Public Function DayOfWeek(ByVal jd As Double) As VbDayOfWeek 'AA S.65 DayOfWeek = Int(jd + 1.5) Mod 7 End Function '------------------------------------------------------------------------------ '------------------------------------------------------------------------------ 'DayOfYearGregorian berechnet die Tageszahl innerhalb des Jahres des 'Gregorianischen Kalenders. Public Function DayOfYearGregorian(ByVal y As Long, ByVal m As Long, _ ByVal d As Long) As Long 'AA S.65, 66 DayOfYearGregorian = DayOfYear(y, m, d, LeapYearGregorian(y)) End Function '------------------------------------------------------------------------------ '------------------------------------------------------------------------------ 'DayOfYearJulian berechnet die Tageszahl innerhalb des Jahres des 'Julianischen Kalenders. Public Function DayOfYearJulian(ByVal y As Long, ByVal m As Long, _ ByVal d As Long) As Long 'AA S.65 DayOfYearJulian = DayOfYear(y, m, d, LeapYearJulian(y)) End Function '------------------------------------------------------------------------------ '------------------------------------------------------------------------------ 'DayOfYear berechnet die Tageszahl innerhalb des Jahres. ' 'Diese Form der Funktion ist nicht spezifisch für den Julianischen oder 'Gregorianischen Kalender, aber Sie müssen ihr sagen, ob das Jahr ein 'Schaltjahr ist. Public Function DayOfYear(ByVal y As Long, ByVal m As Long, _ ByVal d As Long, ByVal leap As Boolean) As Long Dim k As Long 'AA S.65 k = 2 + leap DayOfYear = WholeMonths(m, k) + d End Function '------------------------------------------------------------------------------ '------------------------------------------------------------------------------ 'DayOfYearToCalendar liefert den Kalendermonat und -tag 'für einen bestimmten Tag im Jahr und Schaltjahr. Public Sub DayOfYearToCalendar(ByVal n As Long, ByVal leap As Boolean, _ ByRef m As Long, ByRef d As Long) Dim k As Long 'AA S.66 k = 2 + leap If n < 32 Then m = 1 Else m = Int(9 * (k + n) / 275 + 0.98) End If d = n - WholeMonths(m, k) End Sub '------------------------------------------------------------------------------ '------------------------------------------------------------------------------ 'Hilfsfunktion für DayOfYear und DayOfYearToCalendar Private Function WholeMonths(ByVal m As Long, ByVal k As Long) As Long 'AA S.65, 66 WholeMonths = Int(275 * m / 9) - k * Int((m + 9) / 12) - 30 End Function '------------------------------------------------------------------------------ '------------------------------------------------------------------------------ 'HebrewCalendar liefert interessante Daten und Fakten über ein bestimmtes Jahr. 'Eingabe ist ein julianisches oder gregorianisches Jahr. ' 'Ausgabe: ' a: Jahreszahl im Jüdischen Kalender ' mP: Monatsnummer des Pessach. ' dP: Tageszahl von Pessach. ' mNY: Monatsnummer des jüdischen Neujahrs. ' dNY: Tagesnummer des jüdischen Neujahrs. ' months: Anzahl der Monate in diesem Jahr. ' days: Anzahl der Tage in diesem Jahr. Public Sub HebrewCalendar(ByVal y As Long, ByRef a As Long, _ ByRef mP As Long, ByRef dP As Long, _ ByRef mNY As Long, ByRef dNY As Long, _ ByRef months As Long, ByRef days As Long) Dim d As Long Dim y1 As Long 'AA S.71, 72 a = y + 3760 d = BigD(y) mP = 3 dP = d If dP > 31 Then mP = mP + 1 dP = dP - 31 End If 'Eine Vereinfachung von Meeus' Regel, um 163 Tage hinzuzufügen. 'Monate von Pessach sind entweder März oder April mit d basierend auf März. 'Monate des neuen Jahres sind entweder September oder August, so dass 'd + 163 - (Tage von März bis September = 184) = d - 21 ab September 'basieren muss. mNY = 9 dNY = d - 21 If dNY > 30 Then mNY = mNY + 1 dNY = dNY - 30 End If months = 12 Select Case a Mod 19 Case 0, 3, 6, 8, 11, 14, 17: months = months + 1 End Select 'Ebenso eine Vereinfachung von Meeus' Regel, um die Differenz in 'Kalendertagen von NY eines Jahres zu NY des nächsten zu nehmen. 'NY basiert auf d, also ist der Unterschied in d der Unterschied 'in den Tageszahlen des Jahres. Ergebnis ist die Summe aus dieser 'Zahl und der Anzahl der Tage im westlichen Kalenderjahr. days = 365 y1 = y + 1 If y1 < 1583 Then If LeapYearJulian(y1) Then days = days + 1 Else If LeapYearGregorian(y1) Then days = days + 1 End If days = days + BigD(y1) - d End Sub '------------------------------------------------------------------------------ '------------------------------------------------------------------------------ 'Hilfsmethode wird mehrmals von HebrewCalendar aufgerufen Private Function BigD(ByVal y As Long) As Long Dim c As Long Dim s As Long Dim a As Long Dim b As Long Dim d As Long Dim q As Double Dim fq As Double Dim iq As Long Dim j As Long Dim r As Double 'AA S.71, 72 c = Int(y / 100) If y >= 1583 Then s = Int((3 * c - 5) / 4) a = (12 * y + 12) Mod 19 b = y Mod 4 q = -1.904412361576 + 1.554241796621 * a _ + 0.25 * b _ - 0.003177794022 * y _ + s fq = Int(q) iq = Int(fq) j = (iq + 3 * y + 5 * b + 2 - s) Mod 7 r = q - fq Select Case True Case j = 2 Or j = 4 Or j = 6: d = iq + 23 Case j = 1 And a > 6 And r >= 0.63287037: d = iq + 24 Case j = 0 And a > 11 And r >= 0.897723765: d = iq + 23 Case Else: d = iq + 22 End Select BigD = d End Function '------------------------------------------------------------------------------ '------------------------------------------------------------------------------ 'GregorianToJulian nimmt ein Jahr, Monat und Tag des 'Gregorianischen Kalenders und gibt das entsprechende 'Jahr, Monat und Tag des Julianischen Kalenders zurück. Public Sub GregorianToJulian(ByVal y As Long, ByVal m As Long, ByVal d As Long, _ ByRef jy As Long, ByRef jm As Long, ByRef jd As Long) Dim alpha As Long Dim beta As Long Dim b As Long If m < 3 Then y = y - 1: m = m + 12 alpha = Int(y / 100) beta = 2 - alpha + Int(alpha / 4) b = Int(365.25 * y) + Int(30.6001 * (m + 1)) + d + 1722519 + beta ymd b, jy, jm, jd End Sub '------------------------------------------------------------------------------ '------------------------------------------------------------------------------ 'JulianToGregorian konvertiert eine julianische Kalenderjahr- 'und Tagesnummer in ein Jahr, einen Monat und einen Tag im 'Gregorianischen Kalender. Public Sub JulianToGregorian(ByVal y As Long, ByVal dn As Long, _ ByRef gy As Long, ByRef gm As Long, ByRef gd As Long) Dim jd As Long Dim alpha As Long Dim beta As Long Dim b As Long jd = Int(365.25 * (y - 1)) + 1721423 + dn alpha = Int((jd - 1867216.25) / 36524.25) beta = jd If jd >= 2299161 Then beta = beta + 1 + alpha - Int(alpha / 4) b = beta + 1524 ymd b, gy, gm, gd End Sub '------------------------------------------------------------------------------ '------------------------------------------------------------------------------ 'Hilfsmethode für JulianToGregorian Private Sub ymd(ByVal b As Long, ByRef y As Long, _ ByRef m As Long, ByRef d As Long) Dim c As Long Dim e As Long c = Int((b - 122.1) / 365.25) d = Int(365.25 * c) e = Int((b - d) / 30.6001) ' berechne Rückgaben d = b - d - Int(30.6001 * e) If e < 14 Then m = e - 1 Else m = e - 13 If m > 2 Then y = c - 4716 Else y = c - 4715 End Sub '------------------------------------------------------------------------------ '------------------------------------------------------------------------------ 'IslamicToJulian konvertiert ein islamisches Kalenderdatum in 'eine Julianische Jahres- und Tageszahl. Public Sub IslamicToJulian(ByVal y As Long, ByVal m As Long, ByVal d As Long, _ ByRef jy As Long, ByRef jDN As Long) Dim n As Long Dim q As Long Dim r As Long Dim a As Long Dim W As Long Dim q1 As Long Dim q2 As Long Dim g As Long Dim k As Long Dim e As Long Dim j As Long Dim x As Long 'AA S.74 n = d + Int(29.5001 * (m - 1) + 0.99) q = Int(y / 30) r = y Mod 30 a = Int((11 * r + 3) / 30) W = 404 * q + 354 * r + 208 + a q1 = Int(W / 1461) q2 = W Mod 1461 g = 621 + 28 * q + 4 * q1 k = Int(q2 / 365.2422) e = Int(365.2422 * k) j = q2 - e + n - 1 x = g + k Select Case True Case j > 366 And x Mod 4 = 0: j = j - 366: x = x - 1 Case j > 365 And x Mod 4 > 0: j = j - 365: x = x + 1 End Select jy = x: jDN = j End Sub '------------------------------------------------------------------------------ '------------------------------------------------------------------------------ 'IslamicLeapYear gibt true zurück, wenn das Jahr y des 'islamischen Kalenders ein Schaltjahr ist. Public Function IslamicLeapYear(ByVal y As Long) As Boolean Dim r As Long r = y Mod 30 IslamicLeapYear = (11 * r + 3) Mod 30 > 18 End Function '------------------------------------------------------------------------------ '------------------------------------------------------------------------------ 'JulianToIslamic nimmt ein Jahr, Monat und Tag des Julianischen Kalenders und 'gibt das entsprechende Jahr, Monat und Tag des islamischen Kalenders zurück. Public Sub JulianToIslamic(ByVal y As Long, ByVal m As Long, ByVal d As Long, _ ByRef iy As Long, ByRef im As Long, ByRef id As Long) Dim a As Long Dim b As Long Dim W As Long Dim n As Long Dim c As Long Dim c1 As Double Dim c2 As Long Dim dP As Long Dim q As Long Dim r As Long Dim j As Long Dim k As Long Dim o As Long Dim h As Long Dim jj As Long Dim days As Long Dim s As Long 'AA S.75 W = 2 If y Mod 4 = 0 Then W = 1 n = Int(275 * m / 9) - W * Int((m + 9) / 12) + d - 30 a = y - 623 b = Int(a / 4) c = a Mod 4 c1 = 365.25001 * c c2 = Int(c1) If c1 - c2 > 0.5 Then c2 = c2 + 1 dP = 1461 * b + 170 + c2 q = Int(dP / 10631) r = dP Mod 10631 j = Int(r / 354) k = r Mod 354 o = Int(11 * j + 14 / 30) h = 30 * q + j + 1 jj = k - o + n - 1 days = 354 If IslamicLeapYear(y) Then days = days + 1 If jj > days Then jj = jj - days: h = h + 1 iy = h If jj = 355 Then im = 12 id = 30 Else s = Int((jj - 1) / 29.5) im = 1 + s id = Int(jj - 29.5 * s) End If End Sub '------------------------------------------------------------------------------ #Const UNICODE = False 'zur Ausgabe im Direktfenster auf False setzen '------------------------------------------------------------------------------ 'IslamicMonthname gibt den romanisierten Monatsnamen zurück. Public Function IslamicMonthname(ByVal im As Long) As String Static IMonths As Variant If Not IsArray(IMonths) Then #If UNICODE Then IMonths = Array("Mu" & ChrW$(&H1E25) & "arram", _ ChrW$(&H1E62) & "afar", _ "Rab" & ChrW$(&H12B) & ChrW$(&H2BF) & " I", _ "Rab" & ChrW$(&H12B) & ChrW$(&H2BF) & " II", _ "Jum" & ChrW$(&H101) & "d" & ChrW$(&H101) & " I", _ "Jum" & ChrW$(&H101) & "d" & ChrW$(&H101) & " II", _ "Rajab", _ "Sha" & ChrW$(&H2BF) & "ban", _ "Rama" & ChrW$(&H1E0D) & ChrW$(&H101) & "n", _ "Shaww" & ChrW$(&H101) & "l", _ "Dh" & ChrW$(&H16B) & " al-Qa" & ChrW$(&H2BF) & "da", _ "Dh" & ChrW$(&H16B) & " al-" & ChrW$(&H1E24) & "ijja") #Else IMonths = Array("Muharram", "Safer", "Rabi' I", "Rabi' II", _ "Jumada I", "Jumada II", "Rajab", "Sha'ban", _ "Ramadan", "Shawwal", "Dhu al-Qa'da", "Dhu al-Hijja") #End If End If Select Case im Case 0 To 11: IslamicMonthname = IMonths(im - 1) End Select End Function '------------------------------------------------------------------------------
Beispiele
Sub Beispiel_CalendarGregorianToJD_sputnik() 'AA 7.a, S.61 Dim jd As Double jd = CalendarGregorianToJD(1957, 10, 4.81) Debug.Print Format$(jd, "0.00") 'Ausgabe: '2436116,31 End Sub Sub Beispiel_CalendarGregorianToJD_halley() 'AA 7.c, S.64 Dim jd1 As Double Dim jd2 As Double jd1 = CalendarGregorianToJD(1910, 4, 20) jd2 = CalendarGregorianToJD(1986, 2, 9) Debug.Print Format$(jd2 - jd1, "0 Tag\e") 'Ausgabe: '27689 Tage End Sub Sub Test_Greg() Dim data, a, dt# data = Array(Array(2000, 1, 1.5, 2451545), _ Array(1999, 1, 1, 2451179.5), _ Array(1987, 1, 27, 2446822.5), _ Array(1987, 6, 19.5, 2446966), _ Array(1988, 1, 27, 2447187.5), _ Array(1988, 6, 19.5, 2447332), _ Array(1900, 1, 1, 2415020.5), _ Array(1600, 1, 1, 2305447.5), _ Array(1600, 12, 31, 2305812.5)) For Each a In data dt = CalendarGregorianToJD(a(0), a(1), a(2)) - a(3) If Abs(dt) > 0.1 Then Debug.Print "Fatal: "; Format(dt * 24, "0.00\ "); "Stunden" End If Next End Sub Sub Beispiel_CalendarJulianToJD() 'AA 7.b, S.61 Dim jd As Double jd = CalendarJulianToJD(333, 1, 27.5) Debug.Print Format$(jd, "0.0") 'Ausgabe: '1842713,0 End Sub Sub Test_Juli() 'AA S.62 Dim data, a, dt As Double data = Array(Array(837, 4, 10.3, 2026871.8), _ Array(-123, 12, 31, 1676496.5), _ Array(-122, 1, 1, 1676497.5), _ Array(-1000, 7, 12.5, 1356001), _ Array(-1000, 2, 29, 1355866.5), _ Array(-1001, 8, 17.9, 1355671.4), _ Array(-4712, 1, 1.5, 0)) For Each a In data dt = CalendarJulianToJD(a(0), a(1), a(2)) - a(3) If Abs(dt) > 0.1 Then Debug.Print "Fatal: dt = " & Format$(dt * 24, "0.00 Stunden") End If Next End Sub Sub Test_JuliLeap() Dim data, a data = Array(Array(900, True), _ Array(1236, True), _ Array(750, False), _ Array(1429, False)) For Each a In data If LeapYearJulian(a(0)) <> a(1) Then Debug.Print "Fatal: LeapYearJulian" End If Next End Sub Sub Test_GregLeap() Dim data, a data = Array(Array(1700, False), _ Array(1800, False), _ Array(1900, False), _ Array(2100, False), _ Array(1600, True), _ Array(2000, True), _ Array(2400, True)) For Each a In data If LeapYearGregorian(a(0)) <> a(1) Then Debug.Print "Fatal: LeapYearGregorian" End If Next End Sub Sub Beispiel_JDtoCalendar() 'AA 7.c, S.64 Dim y&, m&, d# JDtoCalendar 2436116.31, y, m, d Debug.Print y; MonthName(m); " "; Format$(d, "0.00") 'Ausgabe: '1957 Oktober 4,81 End Sub Sub Test_YMD() Dim data, a, y&, m&, d# data = Array(Array(1842713, 333, 1, 27.5), _ Array(1507900.13, -584, 5, 28.63)) For Each a In data JDtoCalendar a(0), y, m, d If y <> a(1) Or m <> a(2) Or Abs(d - a(3)) > 0.01 Then Debug.Print "Fatal:"; y; m; d End If Next End Sub Sub Beispiel_DayOfWeek() 'AA 7.e, S.65 Debug.Print WeekdayName(DayOfWeek(2434923.5)) 'Ausgabe: 'Mittwoch End Sub Sub Beispiel_DayOfYear_f() 'AA 7.f, S.65 Debug.Print DayOfYear(1978, 11, 14, False) 'Ausgabe: '316 End Sub Sub Beispiel_DayOfYear_g() 'AA 7.g, S.65 Debug.Print DayOfYear(1988, 4, 22, True) 'Ausgabe: '113 End Sub Sub Test_DOYtoCal() Dim data, a, m&, d& data = Array(Array(1978, 11, 14, False, 318), _ Array(1988, 4, 22, True, 113)) For Each a In data DayOfYearToCalendar a(4), a(3), m, d If m <> a(1) Or d <> a(2) Then Debug.Print "Fatal: DayOfYearToCalendar "; m; d End If Next End Sub Sub Beispiel_HebrewCalendar() 'AA 9.a, S.73 Dim a&, mP&, dP&, mNY&, dNY&, months&, days& HebrewCalendar 1990, a, mP, dP, mNY, dNY, months, days Debug.Print "Hebr Jahr:"; a Debug.Print "Pessach: "; MonthName(mP); dP Debug.Print "Neu Year: "; MonthName(mNY); dNY Debug.Print "Monate: "; months Debug.Print "Tage: "; days 'Ausgabe: 'Montate: 12 'Tage: 354 'Hebr Jahr: 5750 'Pessach: April 10 'Neu Year: September 20 'Monate: 12 'Tage: 354 End Sub Sub Beispiel_IslamicToJulian() 'AA 9.b, S.75 Dim y&, dn& IslamicToJulian 1421, 1, 1, y, dn Debug.Print y; dn 'Ausgabe: '2000 84 End Sub Sub Beispiel_JulianToGregorian() 'AA 9.b, S.75 conversion to Gregorian Dim y&, m&, d& JulianToGregorian 2000, 84, y, m, d Debug.Print d; MonthName(m); y 'Ausgabe: '6 April 2000 End Sub Sub Beispiel_IslamicLeapYear() 'AA 9.b, S.75 indication of leap year If IslamicLeapYear(1421) Then Debug.Print "Das Islamische Jahr 1421 ist ein Schaltjahr mit 355 Tagen." Else Debug.Print "Das Islamische Jahr 1421 ist ein normales Jahr mit 354 Tagen." End If 'Ausgabe: 'Das Islamische Jahr 1421 ist ein normales Jahr mit 354 Tagen. End Sub Sub Beispiel_GregorianToJulian() 'AA 9.c, S.76 conversion to Julian Calendar Dim y&, m&, d& GregorianToJulian 1991, 8, 13, y, m, d Debug.Print y; MonthName(m); " "; d; "Julian" 'Ausgabe: '1991 Juli 31 Julian End Sub Sub Beispiel_JulianToIslamic() 'AA 9.c, S.76 final output Dim y&, m&, d& JulianToIslamic 1991, 7, 31, y, m, d Debug.Print d; IslamicMonthname(m); " d. H."; y 'Ausgabe: '2 Safer d. H. 1412 End Sub
