HebCalVb6 is a VB6/VBA module to demonstrate how to convert a Hebrew date into the Gregorian date. It can be used within Visual Basic or within a Excel Macro.
There are many books and articles that go into depth explaining the history, math and theory of the Hebrew calendar. My goal here is specifically to demonstrate how to apply these rules. In doing so, I tried to use very generic code without using any fancy language-specific features.
Much of the information is based on the excellent website Hebrew Calendar Science and Myths by Remy Landau, and the book, Glimpse of Light by Dr. J. Schamroth.
If you have any questions or comments, please contact me at info@dafaweek.com.
' This code demonstrates how to convert a Hebrew date into a ' Gregorian date. The code is written in VB6/VBA, but I purposely ' used very generic features so it would be easy to translate ' this into other languages. Also, I avoided using many ' optimization in order to make the logic clearer. ' These functions assume that all the current rules of the ' Hebrew calendar were always in existence (which is not true ' since the Hebrew calendar was not always fixed) and all the ' current rules of the Gregorian calendar were always in existence ' (which is not true). ' Here is a very brief description of the Hebrew calendar. ' ' The Hebrew calendar is a lunisolar calendar. This means that ' the months are in sync with the moon and the years stay in sync ' with the sun. A solar year is approximately 365.25 days. A ' lunar month is approximately 29.5 days. Twelve lunar months is ' approximately 354 days (12 * 29.5=354). Thus, a lunar year of ' twelve months is 11.25 days shorter than the solar year. To make ' up for this shortfall, the Hebrew calendar adds a thirteenth ' month to seven years over a nineteen year period. Therefore, over ' a nineteen year period, the Hebrew calendar is approximately the ' same length as a nineteen year solar calendar. ' ' In order to understand this code, you must know the following ' terms: ' Molad - new moon. Hebrew months start around the day of the ' new moon ' Chalakim - 1 / 1080 of an hour or 3 1/3 seconds ' Tishrei - the first month of the Hebrew year (at least for ' these calculations) ' Rosh Hashanah - The Jewish new year which starts on Tishrei 1. ' ' The Hebrew calendar assumes the period of time between one new ' moon to the next is 29 days, 12 hours and 793 chalakim. The first ' molad after creation occurred on Monday, September, 7th -3760 at 5 ' hours and 204 chalakim. Technically, the Gregorian date would be ' in the year 3761 BCE because there was no year 0 in the Gregorian ' calendar, but we will use the year of -3760. ' Sample Usage: ' ' Converts AdarB/7/5765 to 4/6/2005 ' MsgBox(HebToGreg(5765, 7, 26)) ' ' This function returns how many months there has been from the ' first Molad until the beginning of the year nYearH Public Function MonSinceFirstMolad(ByVal nYearH As Long) As Long Dim nMonSinceFirstMolad As Long ' A shortcut to this function can simply be the following formula ' Return Int(((235 * nYearH) - 234) / 19) ' This formula is found in Remy Landau's website and he ' attributes it to Wolfgang Alexander Shochen. I will use a less ' optimized function which I believe shows the underlying logic ' better. ' count how many months there has been in all years up to last ' year. The months of this year hasn't happened yet. nYearH = nYearH - 1 ' In the 19 year cycle, there will always be 235 months. That ' would be 19 years times 12 months plus 7 extra month for the ' leap years. (19 * 12) + 7 = 235. ' Get how many 19 year cycles there has been and multiply it by ' 235 nMonSinceFirstMolad = Int(nYearH / 19) * 235 ' Get the remaining years after the last complete 19 year cycle nYearH = nYearH Mod 19 ' Add 12 months for each of those years nMonSinceFirstMolad = nMonSinceFirstMolad + (12 * nYearH) ' Add the extra months to account for the leap years If nYearH >= 17 Then nMonSinceFirstMolad = nMonSinceFirstMolad + 6 ElseIf nYearH >= 14 Then nMonSinceFirstMolad = nMonSinceFirstMolad + 5 ElseIf nYearH >= 11 Then nMonSinceFirstMolad = nMonSinceFirstMolad + 4 ElseIf nYearH >= 8 Then nMonSinceFirstMolad = nMonSinceFirstMolad + 3 ElseIf nYearH >= 6 Then nMonSinceFirstMolad = nMonSinceFirstMolad + 2 ElseIf nYearH >= 3 Then nMonSinceFirstMolad = nMonSinceFirstMolad + 1 End If MonSinceFirstMolad = nMonSinceFirstMolad End Function ' This function returns if a given year is a leap year. Public Function IsLeapYear(ByVal nYearH As Long) As Boolean Dim nYearInCycle As Long ' Find out which year we are within the cycle. The 19th year of ' the cycle will return 0 nYearInCycle = nYearH Mod 19 IsLeapYear = nYearInCycle = 3 Or _ nYearInCycle = 6 Or _ nYearInCycle = 8 Or _ nYearInCycle = 11 Or _ nYearInCycle = 14 Or _ nYearInCycle = 17 Or _ nYearInCycle = 0 End Function ' This function figures out the Gregorian Date that corresponds to ' the first day of Tishrei, the first month of the Hebrew ' calendar, for a given Hebrew year. Public Function Tishrei1(ByVal nYearH As Long) As Date Dim nMonthsSinceFirstMolad As Long Dim nChalakim As Long Dim nHours As Long Dim nDays As Long Dim nDayOfWeek As Long Dim dTishrei1 As Date ' We want to calculate how many days, hours and chalakim it has ' been from the time of 0 days, 0 hours and 0 chalakim to the ' molad at the beginning of year nYearH. ' ' The period between one new moon to the next is 29 days, 12 ' hours and 793 chalakim. We must multiply that by the amount ' of months that transpired since the first molad. Then we add ' the time of the first molad (Monday, 5 hours and 204 chalakim) nMonthsSinceFirstMolad = MonSinceFirstMolad(nYearH) nChalakim = 793 * nMonthsSinceFirstMolad nChalakim = nChalakim + 204 ' carry the excess Chalakim over to the hours nHours = Int(nChalakim / 1080) nChalakim = nChalakim Mod 1080 nHours = nHours + (nMonthsSinceFirstMolad * 12) nHours = nHours + 5 ' carry the excess hours over to the days nDays = Int(nHours / 24) nHours = nHours Mod 24 nDays = nDays + (29 * nMonthsSinceFirstMolad) nDays = nDays + 2 ' figure out which day of the week the molad occurs. ' Sunday = 1, Moday = 2 ..., Shabbos = 0 nDayOfWeek = nDays Mod 7 ' In a perfect world, Rosh Hashanah would be on the day of the ' molad. The Hebrew calendar makes four exceptions where we ' push off Rosh Hashanah one or two days. This is done to ' prevent three situation. Without explaining why, the three ' situations are: ' 1) We don't want Rosh Hashanah to come out on Sunday, ' Wednesday or Friday ' 2) We don't want Rosh Hashanah to be on the day of the ' molad if the molad occurs after the beginning of 18th ' hour. ' 3) We want to limit years to specific lengths. For non-leap ' years, we limit it to either 353, 354 or 355 days. For ' leap years, we limit it to either 383, 384 or 385 days. ' If setting Rosh Hashanah to the day of the molad will ' cause this year, or the previous year to fall outside ' these lengths, we push off Rosh Hashanah to get the year ' back to a valid length. ' This code handles these exceptions. If Not IsLeapYear(nYearH) And _ nDayOfWeek = 3 And _ (nHours * 1080) + nChalakim >= _ (9 * 1080) + 204 Then ' This prevents the year from being 356 days. We have to push ' Rosh Hashanah off two days because if we pushed it off only ' one day, Rosh Hashanah would comes out on a Wednesday. Check ' the Hebrew year 5745 for an example. nDayOfWeek = 5 nDays = nDays + 2 ElseIf IsLeapYear(nYearH - 1) And _ nDayOfWeek = 2 And _ (nHours * 1080) + nChalakim >= _ (15 * 1080) + 589 Then ' This prevents the previous year from being 382 days. Check ' the Hebrew Year 5766 for an example. If Rosh Hashanah was not ' pushed off a day then 5765 would be 382 days nDayOfWeek = 3 nDays = nDays + 1 Else ' see rule 2 above. Check the Hebrew year 5765 for an example If nHours >= 18 Then nDayOfWeek = nDayOfWeek + 1 nDayOfWeek = nDayOfWeek Mod 7 nDays = nDays + 1 End If ' see rule 1 above. Check the Hebrew year 5765 for an example If nDayOfWeek = 1 Or _ nDayOfWeek = 4 Or _ nDayOfWeek = 6 Then nDayOfWeek = nDayOfWeek + 1 nDayOfWeek = nDayOfWeek Mod 7 nDays = nDays + 1 End If End If ' Here we want to add nDays to creation ' dTishrie1 = creation + nDays ' Unfortunately, VB doesn't handle negative years very well. ' I therefore picked a Random date (1/1/1900) and figured out how ' many days it is after the creation (2067025). Then I subtracted ' 2067025 from nDays. nDays = nDays - 2067025 dTishrei1 = #1/1/1900# ' 2067025 days after creation dTishrei1 = dTishrei1 + nDays Tishrei1 = dTishrei1 End Function ' This function gets the length of a Hebrew year. Public Function LengthOfYear(ByVal nYearH As Long) As Long Dim dThisTishrei1 As Date Dim dNextTishrei1 As Date Dim diff As Long ' subtract the date of this year from the date of next year dThisTishrei1 = Tishrei1(nYearH) dNextTishrei1 = Tishrei1(nYearH + 1) diff = dNextTishrei1 - dThisTishrei1 LengthOfYear = diff End Function ' This function converts a Hebrew date into the Gregorian date ' nYearH - is the Hebrew year ' nMonth - Tishrei=1 ' Cheshvon=2 ' Kislev=3 ' Teyvet=4 ' Shevat=5 ' Adar A=6 (only valid on leap years) ' Adar=7 (Adar B for leap years) ' Nison=8 ' Iyar=9 ' Sivan=10 ' Tamuz=11 ' Av=12 ' Elul=13 Public Function HebToGreg(ByVal nYearH As Long, _ ByVal nMonthH As Long, _ ByVal nDateH As Long) As Date Dim nLengthOfYear As Long Dim bLeap As Boolean Dim dGreg As Date Dim nMonth As Long Dim nMonthLen As Long Dim bHaser As Boolean Dim bShalem As Boolean bLeap = IsLeapYear(nYearH) nLengthOfYear = LengthOfYear(nYearH) ' The regular length of a non-leap year is 354 days. ' The regular length of a leap year is 384 days. ' On regular years, the length of the months are as follows ' Tishrei (1) 30 ' Cheshvon(2) 29 ' Kislev (3) 30 ' Teyvet (4) 29 ' Shevat (5) 30 ' Adar A (6) 30 (only valid on leap years) ' Adar (7) 29 (Adar B for leap years) ' Nison (8) 30 ' Iyar (9) 29 ' Sivan (10) 30 ' Tamuz (11) 29 ' Av (12) 30 ' Elul (13) 29 ' If the year is shorter by one less day, it is called a haser ' year. Kislev on a haser year has 29 days. If the year is longer ' by one day, it is called a shalem year. Cheshvon on a shalem ' year is 30 days. bHaser = nLengthOfYear = 353 Or nLengthOfYear = 383 bShalem = nLengthOfYear = 355 Or nLengthOfYear = 385 ' get the date for Tishrei 1 dGreg = Tishrei1(nYearH) ' Now count up days within the year For nMonth = 1 To nMonthH - 1 Select Case nMonth Case 1, 5, 8, 10, 12 ' 30 day months nMonthLen = 30 Case 4, 7, 9, 11, 13 ' 29 day months nMonthLen = 29 Case 6 ' There is only an Adar A on a leap years nMonthLen = IIf(bLeap, 30, 0) Case 2 ' Cheshvon, see note above nMonthLen = IIf(bShalem, 30, 29) Case 3 ' Kislev, see note above nMonthLen = IIf(bHaser, 29, 30) End Select dGreg = dGreg + nMonthLen Next dGreg = dGreg + (nDateH - 1) HebToGreg = dGreg End Function ' This function converts a Gregorian date into the Hebrew date. The ' function returns the hebrew month as a string in the format MM/DD/YYYY. ' Also, the parameters nYearH, nMonthH and hDateH, which are sent by ' reference, will get set the Hebrew year, month and date. See function ' HebToGreg() for the definition of the month numbers. Public Function GregToHeb(ByVal dGreg As Date, _ ByRef nYearH As Long, _ ByRef nMonthH As Long, _ ByRef nDateH As Long) As String Dim nOneMolad As Double Dim nAvrgYear As Double Dim nDays As Long Dim dTishrei1 As Date Dim nLengthOfYear As Long Dim bLeap As Boolean Dim bHaser As Boolean Dim bShalem As Boolean Dim nMonthLen As Long Dim bWhile As Boolean ' The basic algorythm to get Hebrew date for the Gregorian date dGreg. ' 1) Find out how many days dGreg is after creation. ' 2) Based on those days, estimate the Hebrew year ' 3) Now that we a good estimate of the Hebrew year, use brute force to ' find the Gregorian date for Tishrei 1 prior to or equal to dGreg ' 4) Add to Tishrei 1 the amount of days dGreg is after Tishrei 1 ' Figure out how many days are in a month. ' 29 days + 12 hours + 793 chalakim dGreg = int(dGreg) ' added 04/26/2018 based on e-mail from a Christopher nOneMolad = 29 + (12 / 24) + (793 / (1080 * 24)) ' Figure out the average length of a year. The hebrew year has exactly ' 235 months over 19 years. nAvrgYear = nOneMolad * (235 / 19) ' Get how many days dGreg is after creation. See note as to why I ' use 1/1/1900 and add 2067025 nDays = dGreg - #1/1/1900# nDays = nDays + 2067025 ' 2067025 days after creation ' Guess the Hebrew year. This should be a pretty accurate guess. nYearH = Int(CDbl(nDays) / nAvrgYear) + 1 ' Use brute force to find the exact year nYearH. It is the Tishrei 1 in ' the year <= dGreg. dTishrei1 = Tishrei1(nYearH) If dTishrei1 = dGreg Then ' If we got lucky and landed on the exact date, we can stop here nMonthH = 1 nDateH = 1 Else ' Here is the brute force. Either count up or count down nYearH ' until Tishrei 1 is <= dGreg. If dTishrei1 < dGreg Then ' If Tishrei 1, nYearH is less than dGreg, count nYearH up. Do While Tishrei1(nYearH + 1) <= dGreg nYearH = nYearH + 1 Loop Else ' If Tishrei 1, nYearH is greater than dGreg, count nYearH down. nYearH = nYearH - 1 Do While Tishrei1(nYearH) > dGreg nYearH = nYearH - 1 Loop End If ' Subtract Tishrei 1, nYearH from dGreg. That should leave us with ' how many days we have to add to Tishrei 1 nDays = dGreg - Tishrei1(nYearH) ' Find out what type of year it is so that we know the length of the ' months nLengthOfYear = LengthOfYear(nYearH) bHaser = nLengthOfYear = 353 Or nLengthOfYear = 383 bShalem = nLengthOfYear = 355 Or nLengthOfYear = 385 bLeap = IsLeapYear(nYearH) ' Add nDays to Tishrei 1. nMonthH = 1 Do Select Case nMonthH Case 1, 5, 8, 10, 12' 30 day months nMonthLen = 30 Case 4, 7, 9, 11, 13' 29 day months nMonthLen = 29 Case 6 ' Adar A (6) will be skipped on non-leap years nMonthLen = 30 Case 2 ' Cheshvon, see note above nMonthLen = IIf(bShalem, 30, 29) Case 3 ' Kislev, see note above nMonthLen = IIf(bHaser, 29, 30) End Select If nDays >= nMonthLen Then bWhile = True If bLeap Or nMonthH <> 5 Then nMonthH = nMonthH + 1 Else ' We can skip Adar A (6) if its not a leap year nMonthH = nMonthH + 2 End If nDays = nDays - nMonthLen Else bWhile = False End If Loop While bWhile ' Add the remaining days to Date nDateH = nDays + 1 End If GregToHeb = CStr(nMonthH) & "/" & CStr(nDateH) & "/" & CStr(nYearH) End Function Public Function FormatDateH(nYearH, nMonthH, nDateH) Dim sMonth As String Select Case nMonthH Case 1 sMonth = "Tishrei" Case 2 sMonth = "Cheshvan" Case 3 sMonth = "Kislev" Case 4 sMonth = "Teves" Case 5 sMonth = "Shevat" Case 6 sMonth = "Adar A" Case 7 sMonth = IIf(IsLeapYear(nYearH), "Adar B", "Adar") Case 8 sMonth = "Nisan" Case 9 sMonth = "Iyar" Case 10 sMonth = "Sivan" Case 11 sMonth = "Tamuz" Case 12 sMonth = "Av" Case 13 sMonth = "Elul" End Select FormatDateH = sMonth & " " & CStr(nDateH) & " " & CStr(nYearH) End Function Public Function TodayHeb() Dim nYearH As Long Dim nMonthH As Long Dim nDateH As Long Dim dToday As Date dToday = Int(Now()) GregToHeb dToday, nYearH, nMonthH, nDateH TodayHeb = FormatDateH(nYearH, nMonthH, nDateH) End Function Public Function DateToHeb(dDate) Dim nYearH As Long Dim nMonthH As Long Dim nDateH As Long dDate = CDate(dDate) GregToHeb dDate, nYearH, nMonthH, nDateH DateToHeb = FormatDateH(nYearH, nMonthH, nDateH) End Function |
Some helper hebrew functions
Function HebrewNum(ByVal n As Integer) Dim nX As Integer Dim sHundred As String Dim sTen As String Dim sOne As String n = n Mod 1000 nX = n - (n Mod 100) Select Case nX Case 900 sHundred = Tuf_() & Tuf_() & Raish_() Case 800 sHundred = Tuf_() & Tuf_() & Kuf_() Case 700 sHundred = Tuf_() & Shin_() Case 600 sHundred = Tuf_() & Raish_() Case 500 sHundred = Tuf_() & Kuf_() Case 400 sHundred = Tuf_() Case 300 sHundred = Shin_() Case 200 sHundred = Raish_() Case 100 sHundred = Kuf_() End Select n = n - nX If n = 15 Then sTen = Tes_() sOne = Vav_() ElseIf n = 16 Then sTen = Tes_() sOne = Ziyon_() Else nX = n - (n Mod 10) Select Case nX Case 90 sTen = Tzodi_() Case 80 sTen = Pai_() Case 70 sTen = Iyin_() Case 60 sTen = Samech_() Case 50 sTen = Nun_() Case 40 sTen = Mem_() Case 30 sTen = Lamed_() Case 20 sTen = Chaf_() Case 10 sTen = Yud_() End Select nX = n - nX Select Case nX Case 9 sOne = Tes_() Case 8 sOne = Ches_() Case 7 sOne = Ziyon_() Case 6 sOne = Vav_() Case 5 sOne = Hai_() Case 4 sOne = Daled_() Case 3 sOne = Gimmel_() Case 2 sOne = Bais_() Case 1 sOne = Alef_() End Select End If HebrewNum = sHundred & sTen & sOne End Function Public Function FormatDateHInHeb(nYearH, nMonthH, nDateH) Dim sMonth As String Select Case nMonthH Case 1 sMonth = Tuf_() & Shin_() & Raish_() & Yud_() Case 2 sMonth = Ches_() & Shin_() & Vav_() & Nun_End_() Case 3 sMonth = Chaf_() & Samech_() & Lamed_() & Yud_() & Vav_() Case 4 sMonth = Tes_() & Bais_() & Tuf_() Case 5 sMonth = Shin_() & Bais_() & Tes_() Case 6 sMonth = Alef_() & Daled_() & Raish_() & ChrW(32) & Alef_() Case 7 sMonth = IIf(IsLeapYear(nYearH), _ Alef_() & Daled_() & Raish_() & ChrW(32) & Bais_(), _ Alef_() & Daled_() & Raish_()) Case 8 sMonth = Nun_() & Yud_() & Samech_() & Nun_End_() Case 9 sMonth = Alef_() & Yud_() & Yud_() & Raish_() Case 10 sMonth = Samech_() & Yud_() & Vav_() & Nun_End_() Case 11 sMonth = Tuf_() & Mem_() & Vav_() & Ziyon_() Case 12 sMonth = Alef_() & Bais_() Case 13 sMonth = Alef_() & Lamed_() & Vav_() & Lamed_() End Select FormatDateHInHeb = sMonth & " " & HebrewNum(nDateH) & " " & CStr(nYearH) ' FormatDateHInHeb = sMonth & " " & HebrewNum(nDateH) & " " & HebrewNum(nYearH) End Function Public Function HebDateInHeb(dDate) Dim nYearH As Long Dim nMonthH As Long Dim nDateH As Long dDate = CDate(dDate) GregToHeb dDate, nYearH, nMonthH, nDateH HebDateInHeb = FormatDateHInHeb(nYearH, nMonthH, nDateH) End Function Function Alef_() Alef_ = ChrW(1488) End Function Function Bais_() Bais_ = ChrW(1489) End Function Function Gimmel_() Gimmel_ = ChrW(1490) End Function Function Daled_() Daled_ = ChrW(1491) End Function Function Hai_() Hai_ = ChrW(1492) End Function Function Vav_() Vav_ = ChrW(1493) End Function Function Ziyon_() Ziyon_ = ChrW(1494) End Function Function Ches_() Ches_ = ChrW(1495) End Function Function Tes_() Tes_ = ChrW(1496) End Function Function Yud_() Yud_ = ChrW(1497) End Function Function Chaf_End_() Chaf_End_ = ChrW(1498) End Function Function Chaf_() Chaf_ = ChrW(1499) End Function Function Lamed_() Lamed_ = ChrW(1500) End Function Function Mem_End_() Mem_End_ = ChrW(1501) End Function Function Mem_() Mem_ = ChrW(1502) End Function Function Nun_End_() Nun_End_ = ChrW(1503) End Function Function Nun_() Nun_ = ChrW(1504) End Function Function Samech_() Samech_ = ChrW(1505) End Function Function Iyin_() Iyin_ = ChrW(1506) End Function Function Pai_End_() Pai_End_ = ChrW(1507) End Function Function Pai_() Pai_ = ChrW(1508) End Function Function Tzodi_End_() Tzodi_End_ = ChrW(1509) End Function Function Tzodi_() Tzodi_ = ChrW(1510) End Function Function Kuf_() Kuf_ = ChrW(1511) End Function Function Raish_() Raish_ = ChrW(1512) End Function Function Shin_() Shin_ = ChrW(1513) End Function Function Tuf_() Tuf_ = ChrW(1514) End Function Function UnicodeChar(n As Integer) UnicodeChar = ChrW(n) End Function ' Some handy code to help generate code Public Sub MakeHebrewLet() Dim nRow As Integer Sheets.Add ActiveSheet.Name = "HebrewLet" For nRow = 1 To 27 Cells(nRow, 1) = nRow + 1487 Cells(nRow, 2) = ChrW(nRow + 1487) Select Case nRow Case 1 Cells(nRow, 3) = "Alef" Case 2 Cells(nRow, 3) = "Bais" Case 3 Cells(nRow, 3) = "Gimmel" Case 4 Cells(nRow, 3) = "Daled" Case 5 Cells(nRow, 3) = "Hai" Case 6 Cells(nRow, 3) = "Vav" Case 7 Cells(nRow, 3) = "Ziyon" Case 8 Cells(nRow, 3) = "Ches" Case 9 Cells(nRow, 3) = "Tes" Case 10 Cells(nRow, 3) = "Yud" Case 11 Cells(nRow, 3) = "Chaf_End" Case 12 Cells(nRow, 3) = "Chaf" Case 13 Cells(nRow, 3) = "Lamed" Case 14 Cells(nRow, 3) = "Mem_End" Case 15 Cells(nRow, 3) = "Mem" Case 16 Cells(nRow, 3) = "Nun_End" Case 17 Cells(nRow, 3) = "Nun" Case 18 Cells(nRow, 3) = "Samech" Case 19 Cells(nRow, 3) = "Iyin" Case 20 Cells(nRow, 3) = "Pai_End" Case 21 Cells(nRow, 3) = "Pai" Case 22 Cells(nRow, 3) = "Tzodi_End" Case 23 Cells(nRow, 3) = "Tzodi" Case 24 Cells(nRow, 3) = "Kuf" Case 25 Cells(nRow, 3) = "Raish" Case 26 Cells(nRow, 3) = "Shin" Case 27 Cells(nRow, 3) = "Tuf" End Select Next End Sub Public Function HebSt(s As String) Dim n As Integer For n = 1 To Len(s) If n <> 1 Then HebSt = HebSt + " & " End If HebSt = HebSt + HebLetToFunc(Mid(s, n, 1)) Next End Function Function HebLetToFunc(sHebLet As String) As String Dim nRow As Integer HebLetToFunc = "ChrW(" + CStr(AscW(sHebLet)) & ")" nRow = 1 Do While Sheets("HebrewLet").Cells(nRow, 2) <> "" If Sheets("HebrewLet").Cells(nRow, 2) = sHebLet Then HebLetToFunc = Sheets("HebrewLet").Cells(nRow, 3) & "_()" Exit Do End If nRow = nRow + 1 Loop End Function ' ABGDHVZJTYCLMNSIPQKRWX Function ToHebSt(sHebSt As String) As String Dim n As Integer Dim sCh As String Dim sHebCh As String For n = 1 To Len(sHebSt) sCh = Mid(sHebSt, n, 1) Select Case sCh Case "A" ' Alef sHebCh = ChrW(1488) Case "B" ' Beis sHebCh = ChrW(1489) Case "G" ' Gimmel sHebCh = ChrW(1490) Case "D" ' Daled sHebCh = ChrW(1491) Case "H" ' Hay sHebCh = ChrW(1492) Case "V" ' Vav sHebCh = ChrW(1493) Case "Z" ' Ziyen sHebCh = ChrW(1494) Case "J" ' Ches sHebCh = ChrW(1495) Case "T" ' Tes sHebCh = ChrW(1496) Case "Y" ' Yud sHebCh = ChrW(1497) Case "c" ' cuff Sofit sHebCh = ChrW(1498) Case "C" ' Cuff sHebCh = ChrW(1499) Case "L" ' Lamed sHebCh = ChrW(1500) Case "m" ' Mem Sofit sHebCh = ChrW(1501) Case "M" ' Mem sHebCh = ChrW(1502) Case "n" ' Nun Sofit sHebCh = ChrW(1503) Case "N" ' Nun sHebCh = ChrW(1504) Case "S" ' Samech sHebCh = ChrW(1505) Case "I" ' Iyin sHebCh = ChrW(1506) Case "p" ' Pei Sofit sHebCh = ChrW(1507) Case "P" ' Pei sHebCh = ChrW(1508) Case "q" ' Tzadi Sofit sHebCh = ChrW(1509) Case "Q" ' Tzadi sHebCh = ChrW(1510) Case "K" ' Koof sHebCh = ChrW(1511) Case "R" ' Reish sHebCh = ChrW(1512) Case "W" ' Shin sHebCh = ChrW(1513) Case "X" ' Tuff sHebCh = ChrW(1514) Case Else sHebCh = sCh End Select ToHebSt = ToHebSt & sHebCh Next End Function Public Function HebFormatDateH(nYearH, nMonthH, nDateH) Dim sMonth As String Select Case nMonthH Case 1 sMonth = ToHebSt("XWRY") ' Tishrei Case 2 sMonth = ToHebSt("JWVn") ' Cheshvan Case 3 sMonth = ToHebSt("CSLV") ' Kislev Case 4 sMonth = ToHebSt("TBX") ' Teves Case 5 sMonth = ToHebSt("WBT") ' Shevat Case 6 sMonth = ToHebSt("ADR A") ' Adar A Case 7 sMonth = IIf(IsLeapYear(nYearH), ToHebSt("ADR B"), ToHebSt("ADR")) ' Adar B, Adar Case 8 sMonth = ToHebSt("NYSn") ' Nisan Case 9 sMonth = ToHebSt("AYYR") ' Iyar Case 10 sMonth = ToHebSt("SYVn") ' Sivan Case 11 sMonth = ToHebSt("XMVZ") ' Tamuz Case 12 sMonth = ToHebSt("AB") ' Av Case 13 sMonth = ToHebSt("ALVL") ' Elul End Select HebFormatDateH = sMonth & " " & CStr(nDateH) & " " & CStr(nYearH) End Function Public Function HebDateToHeb(dDate) Dim nYearH As Long Dim nMonthH As Long Dim nDateH As Long dDate = CDate(dDate) GregToHeb dDate, nYearH, nMonthH, nDateH HebDateToHeb = HebFormatDateH(nYearH, nMonthH, nDateH) End Function |
Code to get the Shabbos Parsha
Function GetParsha(d As Date) As String GetParsha = GetParshaX(d, 1, True) End Function Function GetParshaHeb(d As Date) As String GetParshaHeb = GetParshaX(d, 2, True) End Function Function GetParshaHebYesParshas(d As Date) As String GetParshaHebNoParshas = GetParshaX(d, 2, False) End Function Function GetParshaNum(d As Date) As String GetParshaNum = GetParshaX(d, 3) End Function Private Function GetParshaX(d As Date, nType As Integer, Optional bNoPRWX As Boolean) As String Dim nParshaNumber As Integer Dim dTargetShabbos As Date Dim dWorkingShabbos As Date Dim nYearH As Long Dim nMonthH As Long Dim nDateH As Long Dim bIsYomTov As Boolean Dim bDoubleParsha As Boolean Dim bSpecialParsha As Boolean Dim bDone As Boolean Dim sParsha As String Dim aParsha(64) As String If nType = 1 Then aParsha(1) = "Bereishit" aParsha(2) = "Noach" aParsha(3) = "Lech Lecha" aParsha(4) = "Vayeira" aParsha(5) = "Chayei Sarah" aParsha(6) = "Toldot" aParsha(7) = "Vayeitzei" aParsha(8) = "Vayishlach" aParsha(9) = "Vayeishev" aParsha(10) = "Mikeitz" aParsha(11) = "Vayigash" aParsha(12) = "Vayechi" aParsha(13) = "Shemot" aParsha(14) = "Va'eira" aParsha(15) = "Bo" aParsha(16) = "Beshalach" aParsha(17) = "Yitro" aParsha(18) = "Mishpatim" aParsha(19) = "Terumah" aParsha(20) = "Titzaveh" aParsha(21) = "Ki Tisa" aParsha(22) = "Vayakhel" aParsha(23) = "Pekudei" aParsha(24) = "Vayikra" aParsha(25) = "Tzav" aParsha(26) = "Shemini" aParsha(27) = "Tazria" aParsha(28) = "Metzora" aParsha(29) = "Acharei Mot" aParsha(30) = "Kedoshim" aParsha(31) = "Emor" aParsha(32) = "Behar" aParsha(33) = "Bechukotai" aParsha(34) = "Bamidbar" aParsha(35) = "Nasso" aParsha(36) = "Beha'alotcha" aParsha(37) = "Shelach" aParsha(38) = "Korach" aParsha(39) = "Chukat" aParsha(40) = "Balak" aParsha(41) = "Pinchas" aParsha(42) = "Mattot" aParsha(43) = "Masei" aParsha(44) = "Devarim" aParsha(45) = "Ve'etchanan" aParsha(46) = "Eikev" aParsha(47) = "Re'eh" aParsha(48) = "Shoftim" aParsha(49) = "Ki Teitzei" aParsha(50) = "Ki Tavo" aParsha(51) = "Nitzavim" aParsha(52) = "Vayeilech" aParsha(53) = "Haazinu" aParsha(54) = "V'zot HaBrachah" aParsha(55) = "Rosh Hashana" aParsha(56) = "Yom Kippur" aParsha(57) = "Succos" aParsha(58) = "Chol Hamoed Succos" aParsha(59) = "Hoshana Raba" aParsha(60) = "Shmini Atzeres" aParsha(61) = "Simchas Torah" aParsha(62) = "Rosh Chodesh" aParsha(63) = "Chanukah" aParsha(64) = "Asara B'Teves" Else aParsha(1) = ChrW(1489) & ChrW(1512) & ChrW(1488) & ChrW(1513) & ChrW(1497) & ChrW(1514) aParsha(2) = ChrW(1504) & ChrW(1495) aParsha(3) = ChrW(1500) & ChrW(1498) & ChrW(32) & ChrW(1500) & ChrW(1498) aParsha(4) = ChrW(1493) & ChrW(1497) & ChrW(1512) & ChrW(1488) aParsha(5) = ChrW(1495) & ChrW(1497) & ChrW(1497) & ChrW(32) & ChrW(1513) & ChrW(1512) & ChrW(1492) aParsha(6) = ChrW(1514) & ChrW(1493) & ChrW(1500) & ChrW(1491) & ChrW(1514) aParsha(7) = ChrW(1493) & ChrW(1497) & ChrW(1510) & ChrW(1488) aParsha(8) = ChrW(1493) & ChrW(1497) & ChrW(1513) & ChrW(1500) & ChrW(1495) aParsha(9) = ChrW(1493) & ChrW(1497) & ChrW(1513) & ChrW(1489) aParsha(10) = ChrW(1502) & ChrW(1511) & ChrW(1509) aParsha(11) = ChrW(1493) & ChrW(1497) & ChrW(1490) & ChrW(1513) aParsha(12) = ChrW(1493) & ChrW(1497) & ChrW(1495) & ChrW(1497) aParsha(13) = ChrW(1513) & ChrW(1502) & ChrW(1493) & ChrW(1514) aParsha(14) = ChrW(1493) & ChrW(1488) & ChrW(1512) & ChrW(1488) aParsha(15) = ChrW(1489) & ChrW(1488) aParsha(16) = ChrW(1489) & ChrW(1513) & ChrW(1500) & ChrW(1495) aParsha(17) = ChrW(1497) & ChrW(1514) & ChrW(1512) & ChrW(1493) aParsha(18) = ChrW(1502) & ChrW(1513) & ChrW(1508) & ChrW(1496) & ChrW(1497) & ChrW(1501) aParsha(19) = ChrW(1514) & ChrW(1512) & ChrW(1493) & ChrW(1502) & ChrW(1492) aParsha(20) = ChrW(1514) & ChrW(1510) & ChrW(1493) & ChrW(1492) aParsha(21) = ChrW(1499) & ChrW(1497) & ChrW(32) & ChrW(1514) & ChrW(1513) & ChrW(1488) aParsha(22) = ChrW(1493) & ChrW(1497) & ChrW(1511) & ChrW(1492) & ChrW(1500) aParsha(23) = ChrW(1508) & ChrW(1511) & ChrW(1493) & ChrW(1491) & ChrW(1497) aParsha(24) = ChrW(1493) & ChrW(1497) & ChrW(1511) & ChrW(1512) & ChrW(1488) aParsha(25) = ChrW(1510) & ChrW(1493) aParsha(26) = ChrW(1513) & ChrW(1502) & ChrW(1497) & ChrW(1504) & ChrW(1497) aParsha(27) = ChrW(1514) & ChrW(1494) & ChrW(1512) & ChrW(1497) & ChrW(1506) aParsha(28) = ChrW(1502) & ChrW(1510) & ChrW(1493) & ChrW(1512) & ChrW(1506) aParsha(29) = ChrW(1488) & ChrW(1495) & ChrW(1512) & ChrW(1497) & ChrW(32) & ChrW(1502) & ChrW(1493) & ChrW(1514) aParsha(30) = ChrW(1511) & ChrW(1491) & ChrW(1513) & ChrW(1497) & ChrW(1501) aParsha(31) = ChrW(1488) & ChrW(1502) & ChrW(1493) & ChrW(1512) aParsha(32) = ChrW(1489) & ChrW(1492) & ChrW(1512) aParsha(33) = ChrW(1489) & ChrW(1495) & ChrW(1511) & ChrW(1514) & ChrW(1497) aParsha(34) = ChrW(1489) & ChrW(1502) & ChrW(1491) & ChrW(1489) & ChrW(1512) aParsha(35) = ChrW(1504) & ChrW(1513) & ChrW(1488) aParsha(36) = ChrW(1489) & ChrW(1492) & ChrW(1506) & ChrW(1500) & ChrW(1514) & ChrW(1498) aParsha(37) = ChrW(1513) & ChrW(1500) & ChrW(1495) & ChrW(32) & ChrW(1500) & ChrW(1498) aParsha(38) = ChrW(1511) & ChrW(1512) & ChrW(1495) aParsha(39) = ChrW(1495) & ChrW(1511) & ChrW(1514) aParsha(40) = ChrW(1489) & ChrW(1500) & ChrW(1511) aParsha(41) = ChrW(1508) & ChrW(1497) & ChrW(1504) & ChrW(1495) & ChrW(1505) aParsha(42) = ChrW(1502) & ChrW(1496) & ChrW(1493) & ChrW(1514) aParsha(43) = ChrW(1502) & ChrW(1505) & ChrW(1506) & ChrW(1497) aParsha(44) = ChrW(1491) & ChrW(1489) & ChrW(1512) & ChrW(1497) & ChrW(1501) aParsha(45) = ChrW(1493) & ChrW(1488) & ChrW(1514) & ChrW(1495) & ChrW(1504) & ChrW(1503) aParsha(46) = ChrW(1506) & ChrW(1511) & ChrW(1489) aParsha(47) = ChrW(1512) & ChrW(1488) & ChrW(1492) aParsha(48) = ChrW(1513) & ChrW(1493) & ChrW(1508) & ChrW(1496) & ChrW(1497) & ChrW(1501) aParsha(49) = ChrW(1499) & ChrW(1497) & ChrW(32) & ChrW(1514) & ChrW(1510) & ChrW(1488) aParsha(50) = ChrW(1499) & ChrW(1497) & ChrW(32) & ChrW(1514) & ChrW(1489) & ChrW(1493) & ChrW(1488) aParsha(51) = ChrW(1504) & ChrW(1510) & ChrW(1489) & ChrW(1497) & ChrW(1501) aParsha(52) = ChrW(1493) & ChrW(1497) & ChrW(1500) & ChrW(1498) aParsha(53) = ChrW(1492) & ChrW(1488) & ChrW(1494) & ChrW(1497) & ChrW(1504) & ChrW(1493) aParsha(54) = ChrW(1493) & ChrW(1494) & ChrW(1488) & ChrW(1514) & ChrW(32) & ChrW(1492) & ChrW(1489) & ChrW(1512) & ChrW(1499) & ChrW(1492) aParsha(55) = ChrW(1512) & ChrW(1488) & ChrW(1513) & ChrW(32) & ChrW(1492) & ChrW(1513) & ChrW(1504) & ChrW(1492) aParsha(56) = ChrW(1497) & ChrW(1493) & ChrW(1501) & ChrW(32) & ChrW(1499) & ChrW(1497) & ChrW(1508) & ChrW(1493) & ChrW(1512) aParsha(57) = ChrW(1505) & ChrW(1493) & ChrW(1499) & ChrW(1493) & ChrW(1514) aParsha(58) = ChrW(1495) & ChrW(1493) & ChrW(1492) & ChrW(34) & ChrW(1502) & ChrW(32) & ChrW(1505) & ChrW(1493) & ChrW(1499) & ChrW(1493) & ChrW(1514) aParsha(59) = ChrW(1492) & ChrW(1493) & ChrW(1513) & ChrW(1506) & ChrW(1504) & ChrW(1488) & ChrW(32) & ChrW(1512) & ChrW(1489) & ChrW(1488) aParsha(60) = ChrW(1513) & ChrW(1502) & ChrW(1497) & ChrW(1504) & ChrW(1497) & ChrW(32) & ChrW(1506) & ChrW(1510) & ChrW(1512) & ChrW(1514) aParsha(61) = ChrW(1513) & ChrW(1502) & ChrW(1495) & ChrW(1514) & ChrW(32) & ChrW(1514) & ChrW(1493) & ChrW(1512) & ChrW(1492) aParsha(62) = ChrW(1512) & ChrW(1488) & ChrW(1513) & ChrW(32) & ChrW(1495) & ChrW(1493) & ChrW(1491) & ChrW(1513) aParsha(63) = ChrW(1495) & ChrW(1504) & ChrW(1493) & ChrW(1499) & ChrW(1492) aParsha(64) = ChrW(1506) & ChrW(1513) & ChrW(1512) & ChrW(1492) & ChrW(32) & ChrW(1489) & ChrW(1496) & ChrW(1489) & ChrW(1514) End If dTargetShabbos = ShabbosOfDate(d) dWorkingShabbos = InitWorkingShabbos(d) nParshaNumber = (dTargetShabbos - dWorkingShabbos) / 7 If nParshaNumber < 22 Then sParsha = aParsha(nParshaNumber) Else dWorkingShabbos = dWorkingShabbos + (7 * 22) nParshaNumber = 22 Do While Not bDone GregToHeb dWorkingShabbos, nYearH, nMonthH, nDateH bIsYomTov = IsYomTov(nYearH, nMonthH, nDateH) bDoubleParsha = False Select Case nParshaNumber Case 22 If DaysBeforePesach(dWorkingShabbos, nYearH) < 21 Then bDoubleParsha = True End If Case 27, 29 If Not IsLeapYear(nYearH) Then bDoubleParsha = True End If Case 32 If IsIsrael Then ' Inside Israel: Combine if Passover does not start on Shabbat AND NOT a leap year. ' The Passover exception only occurs in a 354-day year in which Rosh HaShanah starts on Thursda Else If Not IsLeapYear(nYearH) Then bDoubleParsha = True End If End If Case 39 If Not IsIsrael Then ' if Pesach falls out on thursday If Weekday(HebToGreg(nYearH, 8, 15)) = vbThursday Then bDoubleParsha = True End If End If Case 42 If DaysBeforeTishaBav(dWorkingShabbos, nYearH) < 14 Then bDoubleParsha = True End If Case 51 If Weekday(HebToGreg(nYearH + 1, 1, 1)) = vbSaturday Or _ Weekday(HebToGreg(nYearH + 1, 1, 10)) = vbSaturday Then bDoubleParsha = True End If End Select If dTargetShabbos = dWorkingShabbos Then If bIsYomTov Then If nType = 1 Then sParsha = TheYomTov(nYearH, nMonthH, nDateH, dWorkingShabbos) Else sParsha = TheYomTovHeb(nYearH, nMonthH, nDateH, dWorkingShabbos) End If bDone = True Else sParsha = aParsha(nParshaNumber) If bDoubleParsha Then sParsha = sParsha & "-" & aParsha(nParshaNumber + 1) End If bDone = True End If End If If Not bDone Then If nParshaNumber > UBound(aParsha) Then sParsha = "Hmmm" ' debug bDone = True Else If Not bIsYomTov Then If bDoubleParsha Then nParshaNumber = nParshaNumber + 2 Else nParshaNumber = nParshaNumber + 1 End If End If dWorkingShabbos = dWorkingShabbos + 7 End If End If Loop End If If Not bIsYomTov And Len(sParsha) < 9 And Not bNoPRWX Then sParsha = ToHebSt("PRWX") & " " & sParsha End If GetParshaX = sParsha End Function Function TheYomTov(nYearH As Long, nMonthH As Long, nDateH As Long, dDate As Date) As String If IsRoshHashana(nYearH, nMonthH, nDateH) Then TheYomTov = "Rosh Hashana" ElseIf IsYomKippur(nYearH, nMonthH, nDateH) Then TheYomTov = "Yom Kippur" ElseIf IsSuccosYT(nYearH, nMonthH, nDateH) Then TheYomTov = "Succos" ElseIf IsSuccosCH(nYearH, nMonthH, nDateH) Then TheYomTov = "Chol Hamoed Succos" ElseIf IsHoshanaRaba(nYearH, nMonthH, nDateH) Then TheYomTov = "Hoshana Raba" ElseIf IsShminiAtzeres(nYearH, nMonthH, nDateH) Then TheYomTov = "Shmini Atzeres" ElseIf IsSimchasTorah(nYearH, nMonthH, nDateH) Then TheYomTov = "Simchas Torah" ElseIf IsChanukah(nYearH, nMonthH, nDateH) And _ IsRoshChodesh(nYearH, nMonthH, nDateH) Then TheYomTov = "Chanukah/R""Ch" ElseIf IsChanukah(nYearH, nMonthH, nDateH) Then TheYomTov = "Chanukah" ElseIf IsRoshChodesh(nYearH, nMonthH, nDateH) Then TheYomTov = "Rosh Chodesh" ElseIf IsPesachYT(nYearH, nMonthH, nDateH) Then TheYomTov = "Pesach" ElseIf IsPesachCH(nYearH, nMonthH, nDateH) Then TheYomTov = "Chol Hamoed Pesach" ElseIf IsShavuos(nYearH, nMonthH, nDateH) Then TheYomTov = "Shevuos" Else TheYomTov = "" End If End Function Function TheYomTovHeb(nYearH As Long, nMonthH As Long, nDateH As Long, dDate As Date) As String If IsRoshHashana(nYearH, nMonthH, nDateH) Then TheYomTovHeb = ToHebSt("RAW HWNH") ElseIf IsYomKippur(nYearH, nMonthH, nDateH) Then TheYomTovHeb = ToHebSt("YVm CYPVR") ElseIf IsSuccosYT(nYearH, nMonthH, nDateH) Then TheYomTovHeb = ToHebSt("SVCVX") ElseIf IsSuccosCH(nYearH, nMonthH, nDateH) Then TheYomTovHeb = ToHebSt("JVH""M SVCVX") ElseIf IsHoshanaRaba(nYearH, nMonthH, nDateH) Then TheYomTovHeb = ToHebSt("HVWINA RBA") ElseIf IsShminiAtzeres(nYearH, nMonthH, nDateH) Then TheYomTovHeb = ToHebSt("WMYNY IQRX") ElseIf IsSimchasTorah(nYearH, nMonthH, nDateH) Then TheYomTovHeb = ToHebSt("WMJX XVRH") ElseIf IsChanukah(nYearH, nMonthH, nDateH) And _ IsRoshChodesh(nYearH, nMonthH, nDateH) Then TheYomTovHeb = ToHebSt("JNVCH / R""J") ElseIf IsChanukah(nYearH, nMonthH, nDateH) Then TheYomTovHeb = ToHebSt("JNVCH") ElseIf IsRoshChodesh(nYearH, nMonthH, nDateH) Then TheYomTovHeb = ToHebSt("RAW JVDW") ElseIf Is10Teves(nYearH, nMonthH, nDateH, dDate) Then TheYomTovHeb = ToHebSt("IWRH BTBX") ElseIf Is15Shevat(nYearH, nMonthH, nDateH, dDate) Then TheYomTovHeb = ToHebSt("TV BWBT") ElseIf IsPurimKatan(nYearH, nMonthH, nDateH, dDate) Then TheYomTovHeb = ToHebSt("PVRYm KTn") ElseIf IsShushanPurimKatan(nYearH, nMonthH, nDateH, dDate) Then TheYomTovHeb = ToHebSt("W""P KTn") ElseIf IsPurim(nYearH, nMonthH, nDateH, dDate) Then TheYomTovHeb = ToHebSt("PVRYm") ElseIf IsShushanPurim(nYearH, nMonthH, nDateH, dDate) Then TheYomTovHeb = ToHebSt("WVWn PVRYm") ElseIf IsPesachYT(nYearH, nMonthH, nDateH) Then TheYomTovHeb = ToHebSt("PSJ") ElseIf IsPesachCH(nYearH, nMonthH, nDateH) Then TheYomTovHeb = ToHebSt("JVH""M PSJ") ElseIf IsLagBOmer(nYearH, nMonthH, nDateH) Then TheYomTovHeb = ToHebSt("L""G BIVMR") ElseIf IsShavuos(nYearH, nMonthH, nDateH) Then TheYomTovHeb = ToHebSt("WBVIVX") ElseIf Is17Tamuz(nYearH, nMonthH, nDateH, dDate) Then TheYomTovHeb = ToHebSt("Y""Z BXMVZ") ElseIf Is9BAv(nYearH, nMonthH, nDateH, dDate) Then TheYomTovHeb = ToHebSt("T' BAB") ElseIf Is15BAv(nYearH, nMonthH, nDateH, dDate) Then TheYomTovHeb = ToHebSt("T""V BAB") Else TheYomTovHeb = "" End If End Function Private Function DaysBeforePesach(dWorkingShabbos, nYearH) As Integer Dim dErevPesach As Date dErevPesach = HebToGreg(nYearH, 8, 14) DaysBeforePesach = dErevPesach - dWorkingShabbos End Function Private Function DaysBeforeTishaBav(dWorkingShabbos, nYearH) As Integer Dim dTishaBav As Date dTishaBav = HebToGreg(nYearH, 12, 9) DaysBeforeTishaBav = dTishaBav - dWorkingShabbos End Function Private Function IsYomTov(nYearH As Long, nMonthH As Long, nDateH As Long) As Boolean IsYomTov = IsRoshHashana(nYearH, nMonthH, nDateH) Or _ IsYomKippur(nYearH, nMonthH, nDateH) Or _ IsSuccos(nYearH, nMonthH, nDateH) Or _ IsPesach(nYearH, nMonthH, nDateH) Or _ IsShavuos(nYearH, nMonthH, nDateH) End Function Private Function IsRoshHashana(nYearH As Long, nMonthH As Long, nDateH As Long) As Boolean IsRoshHashana = nMonthH = 1 And _ nDateH >= 1 And _ nDateH <= 2 End Function Private Function IsYomKippur(nYearH As Long, nMonthH As Long, nDateH As Long) As Boolean IsYomKippur = nMonthH = 1 And _ nDateH = 10 End Function Private Function IsPesach(nYearH As Long, nMonthH As Long, nDateH As Long) As Boolean IsPesach = IsYomTovX(nYearH, nMonthH, nDateH, 8, 15, 7) End Function Private Function IsShavuos(nYearH As Long, nMonthH As Long, nDateH As Long) As Boolean IsShavuos = IsYomTovX(nYearH, nMonthH, nDateH, 10, 6, 1) End Function Private Function IsSuccos(nYearH As Long, nMonthH As Long, nDateH As Long) As Boolean IsSuccos = IsYomTovX(nYearH, nMonthH, nDateH, 1, 15, 8) End Function Private Function IsSuccosYT(nYearH As Long, nMonthH As Long, nDateH As Long) As Boolean IsSuccosYT = IsYomTovX(nYearH, nMonthH, nDateH, 1, 15, 1) End Function Private Function IsSuccosCH(nYearH As Long, nMonthH As Long, nDateH As Long) As Boolean If IsIsrael() Then IsSuccosCH = IsYomTovX(nYearH, nMonthH, nDateH, 1, 16, 4) Else IsSuccosCH = IsYomTovX(nYearH, nMonthH, nDateH, 1, 17, 3) End If End Function Private Function IsHoshanaRaba(nYearH As Long, nMonthH As Long, nDateH As Long) As Boolean IsHoshanaRaba = nMonthH = 1 And _ nDateH = 21 End Function Function IsShminiAtzeres(nYearH As Long, nMonthH As Long, nDateH As Long) As Boolean IsShminiAtzeres = nMonthH = 1 And nDateH = 22 End Function Function IsSimchasTorah(nYearH As Long, nMonthH As Long, nDateH As Long) As Boolean IsSimchasTorah = nMonthH = 1 And nDateH = IIf(IsIsrael(), 22, 23) End Function Function IsRoshChodesh(nYearH As Long, nMonthH As Long, nDateH As Long) As Boolean IsRoshChodesh = nDateH = 1 Or nDateH = 30 End Function Function IsChanukah(nYearH As Long, nMonthH As Long, nDateH As Long) As Boolean Dim nLengthOfYear As Integer Dim bHaser As Boolean If nMonthH = 3 And nDateH >= 25 Then IsChanukah = True ElseIf nMonthH = 4 Then nLengthOfYear = LengthOfYear(nYearH) bHaser = nLengthOfYear = 353 Or nLengthOfYear = 383 IsChanukah = nDateH <= IIf(bHaser, 3, 2) Else IsChanukah = False End If End Function Function Is10Teves(nYearH As Long, nMonthH As Long, nDateH As Long, dDate As Date) As Boolean Is10Teves = IsFastDay(nYearH, nMonthH, nDateH, dDate, 4, 10) End Function Function Is15Shevat(nYearH As Long, nMonthH As Long, nDateH As Long, dDate As Date) As Boolean Is15Shevat = nMonthH = 5 And nDateH = 15 End Function Function IsPurimKatan(nYearH As Long, nMonthH As Long, nDateH As Long, dDate As Date) As Boolean IsPurimKatan = nMonthH = 6 And nDateH = 14 End Function Function IsShushanPurimKatan(nYearH As Long, nMonthH As Long, nDateH As Long, dDate As Date) As Boolean IsShushanPurimKatan = nMonthH = 6 And nDateH = 15 End Function Function IsPurim(nYearH As Long, nMonthH As Long, nDateH As Long, dDate As Date) As Boolean IsPurim = nMonthH = 7 And nDateH = 14 End Function Function IsShushanPurim(nYearH As Long, nMonthH As Long, nDateH As Long, dDate As Date) As Boolean IsShushanPurim = nMonthH = 7 And nDateH = 15 End Function Private Function IsPesachYT(nYearH As Long, nMonthH As Long, nDateH As Long) As Boolean IsPesachYT = IsYomTovX(nYearH, nMonthH, nDateH, 8, 15, 1) Or _ IsYomTovX(nYearH, nMonthH, nDateH, 8, 21, 1) End Function Private Function IsPesachCH(nYearH As Long, nMonthH As Long, nDateH As Long) As Boolean If IsIsrael() Then IsPesachCH = IsYomTovX(nYearH, nMonthH, nDateH, 8, 16, 4) Else IsPesachCH = IsYomTovX(nYearH, nMonthH, nDateH, 8, 17, 3) End If End Function Private Function IsLagBOmer(nYearH As Long, nMonthH As Long, nDateH As Long) As Boolean IsLagBOmer = nMonthH = 9 And _ nDateH = 18 End Function Function Is17Tamuz(nYearH As Long, nMonthH As Long, nDateH As Long, dDate As Date) As Boolean Is17Tamuz = IsFastDay(nYearH, nMonthH, nDateH, dDate, 11, 17) End Function Function Is9BAv(nYearH As Long, nMonthH As Long, nDateH As Long, dDate As Date) As Boolean Is9BAv = IsFastDay(nYearH, nMonthH, nDateH, dDate, 12, 9) End Function Function Is15BAv(nYearH As Long, nMonthH As Long, nDateH As Long, dDate As Date) As Boolean Is15BAv = nMonthH = 12 And _ nDateH = 15 End Function Function IsFastDay(nYearH As Long, nMonthH As Long, nDateH As Long, dDate As Date, nMonthHX As Long, nDateHX As Long) As Boolean If nMonthH = nMonthHX Then If nDateH = nDateHX Then IsFastDay = Weekday(dDate) <> vbSaturday ElseIf nDateH = nDateHX + 1 Then IsFastDay = Weekday(dDate - 1) = vbSaturday End If End If End Function Private Function IsYomTovX(nYearH As Long, nMonthH As Long, nDateH As Long, nYTMonth, nYTDate, nYTLen) As Boolean Dim nEOYomTov As Integer nEOYomTov = nYTDate + nYTLen - 1 If Not IsIsrael Then nEOYomTov = nEOYomTov + 1 End If IsYomTovX = nMonthH = nYTMonth And _ nDateH >= nYTDate And _ nDateH <= nEOYomTov End Function Private Function InitWorkingShabbos(d As Date) As Date d = ShabbosOfDate(d) InitWorkingShabbos = ShabbosOfDate(PreviousSimchasTorah(d)) - 7 End Function Private Function ShabbosOfDate(d As Date) As Date ShabbosOfDate = d + (7 - Weekday(d)) End Function Private Function PreviousSimchasTorah(d As Date) As Date Dim nYearH As Long Dim nMonthH As Long Dim nDateH As Long Dim nSTDateH As Long GregToHeb d, nYearH, nMonthH, nDateH nSTDateH = IIf(IsIsrael, 22, 23) If nDateH < nSTDateH And nMonthH = 1 Then nYearH = nYearH - 1 End If PreviousSimchasTorah = HebToGreg(nYearH, 1, nSTDateH) End Function Private Function IsIsrael() As Boolean IsIsrael = False End Function |