הפונקציה GetHDate שלהלן מחשבת את התאריך העברי ע"פ התאריך הגרגוריאני (הלועזי). כמו כן מחזירה הפונקציה את היום והשנה העבריים בגימטריה, את שם החודש העברי ושם חג יהודי או ישראלי החל באותו היום.

לצורך השימוש בפונקציה יש צורך ב-Visual Basic בגירסה 3 ומעלה או ב-Visual Basic for Applications המצורף לOffice 97-. כמובן שכדי לראות את האותיות העבריות דרוש Windows עם תמיכה בעברית.

1. העתק את כל הפונקציות הבאות למודול או טופס קיימים בפרוייקט Visual Basic.
2. הגדר משתנה מטיפוס HDateType (לצורך הדוגמה נקרא לו silvester) ע"י הפקודה:

Dim silvester As HDateType

3. קרא לפונקציה (התאריך שבסוגריים יכול להיות גם משתנה מטיפוס Date):

silvester = GetHDate(#12-31-97#)

4. הערכים שיתקבלו הם:

silvester.day - היום בחודש העברי

silvester.hday - היום בחודש העברי בגימטריה

silvester.month - מספר החודש העברי

silvester.hmonth - שם החודש העברי

silvester.year - השנה העברית (מספר השנים מבריאת העולם)

silvester.hyear - השנה העברית בגימטריה

בכל שאלה ובקשה ניתן לפנות לדורון סער ב-saar3@hotmail.com..

'********************************************************************

'********************************************************************

'הגדרות כלליות

Type HDateType

End Type

'.החזר את המספר באופן גימטרי באותיות

'הפונקציה רקורסיבית כדי לכלול ערכים הגדולים

'או שווים לאלף

Function GetGimatrics$(ByVal Num%)

'Num% - מספר שלם להמרה

Dim r$

Dim Digit%

r$ = ""

'אם המספר גדול (או שווה) לאלף, מצא את הגימטריה של

'החלוקה השלמה של המספר באלף

If Num% >= 1000 Then

r$ = GetGimatrics$(Num% \ 1000)

Num = Num Mod 1000

End If

'ספרת המאות

'אם המספר גדול או שווה ל-900, הוסף קדומת של

'האותיות תתק

If Num% >= 900 Then r$ = r$ + "תתק"

'אם המספר גדול או שווה ל-500, הוסף קדומת של

'האות ת' ואות נוספת בין ק-ת

If Num% >= 500 And Num% < 900 Then

r$ = r$ + "ת"

r$ = r$ + Chr$(Asc("ק") + (Num \ 100 - 5))

End If

'אם המספר גדול מ-100 הוסף אות בין ק-ת

If Num >= 100 And Num < 500 Then

r$ = r$ + Chr$(Asc("ק") + (Num \ 100 - 1))

End If

'ספרת העשרות

'אם המספר ללא מאות גדול מ-10 הוסף את האות המתאימה

Digit = (Num Mod 100) \ 10

If Digit Then

Select Case Digit 'הספרה

Case 1: r$ = r$ + "י"

Case 2: r$ = r$ + "כ"

Case 3: r$ = r$ + "ל"

Case 4: r$ = r$ + "מ"

Case 5 To 7: r$ = r$ + Chr$(Asc("נ") + Digit - 5)

Case 8: r$ = r$ + "פ"

Case 9: r$ = r$ + "צ"

End Select

End If

'אם יש ספרת אחדות הוסף אותה

Digit = (Num Mod 10)

If Digit Then r$ = r$ + Chr$(Asc("א") + Digit - 1)

'מנע יה ויו

If r$ = "יה" Then r$ = "טו"

If r$ = "יו" Then r$ = "טז"

GetGimatrics = r$

End Function

'ממיר תאריך גרגוריאני לתאריך עברי

'HDateType מחזיר ערך מטיפוס

'הכולל גם את התאריך בגימטריה, את שם

'החודש העברי ושם חג החל באותו היום

Function GetHDate(ByVal GDate As Date) As HDateType

Dim HDate As HDateType 'התאריך העברי

Dim JDate As Date 'התאריך היוליאני

Dim PDate As Date 'התאריך היוליאני של טו בניסן אותה השנה

Dim PDis As Integer 'כמה ימים באותה השנה צריך לחכות מפסח

Dim PPDate As Date 'התאריך היוליאני של הפסח הקודם

Dim LYL% 'אורך השנה העברית האחרונה

Dim KislevL%, HeshvanL% 'מספר הימים בחשוון ובכיסלו

'ערכי ברירת מחדל

KislevL = 30: HeshvanL = 29 'שנה כסדרה

'חישוב הלוח היוליאני בהתאם להפרש הקבוע

JDate = GDate - 13

'חישוב השנה העברית

HDate.Year = Year(JDate) + 3760

'יתכן יהיה צורך להוסיף 1 למספר זה, אם התאריך חל

'לאחר תחילת השנה העברית הבאה

GetHDate 'חשב את התאריך היוליאני של טו בניסן אותה השנה

PDate = GetPDate(HDate.Year)

'כמה ימים אחרי פסח נמצא התאריך המבוקש

PDis = JDate - PDate

'אם הפער גדול מ 162 ימים יש לעבור לשנה הבאה

If PDis > 162 Then

HDate.Year = Year(JDate) + 3761

GoTo GetHDate End If

'הצב את טו בניסן והוסף את מספר הימים הדרוש

HDate.Month = 7

HDate.Day = 15 + PDis

'-15-במידה והיום בחודש גדול מ

'אין חשיבות לסוג השנה

If HDate.Day > 0 Then

'עבור על רשימת החודשים עד אלול ומצא את התאריך העברי

If HDate.Day > 30 Then HDate.Month = 8: HDate.Day = HDate.Day - 30 'ניסן

If HDate.Day > 29 Then HDate.Month = 9: HDate.Day = HDate.Day - 29 'אייר

If HDate.Day > 30 Then HDate.Month = 10: HDate.Day = HDate.Day - 30 'סיוון

If HDate.Day > 29 Then HDate.Month = 11: HDate.Day = HDate.Day - 29 'תמוז

If HDate.Day > 30 Then HDate.Month = 12: HDate.Day = HDate.Day - 30 'אב

If HDate.Day > 29 Then HDate.Month = 13: HDate.Day = HDate.Day - 29 'אלול

Else

'יש לחשב את סוג השנה. באמצעות נוסחת

'גאוס נחשב את אורכה

'חישוב התאריך היוליאני בו חל ט"ו בניסן

'של השנה הקודמת

PPDate = GetPDate(HDate.Year - 1)

'אורך השנה העברית האחרונה הוא

LYL = PDate - PPDate

'עבור על רשימת החודשים בשנה מעוברת

' ובשנה לא מעוברת

'מספר הימים בכיסלו ובחשון

If LYL = 385 Or LYL = 355 Then HeshvanL = 30 'שנה שלמה

If LYL = 383 Or LYL = 353 Then KislevL = 29 'שנה חסרה

'מעבר לאורך החודשים

If LYL > 360 Then 'שנה מעוברת

'מספרו של אדר א' הוא 6.1

'מספרו של אדר ב' הוא 6.2

If HDate.Day < 1 Then HDate.Month = 6.2: HDate.Day = HDate.Day + 29 'אדר ב

If HDate.Day < 1 Then HDate.Month = 6.1: HDate.Day = HDate.Day + 30 'אדר א

Else 'שנה פשוטה

If HDate.Day < 1 Then HDate.Month = 6: HDate.Day = HDate.Day + 29 'אדר

End If

If HDate.Day < 1 Then HDate.Month = 5: HDate.Day = HDate.Day + 30 'שבט

If HDate.Day < 1 Then HDate.Month = 4: HDate.Day = HDate.Day + 29 'טבת

If HDate.Day < 1 Then HDate.Month = 3: HDate.Day = HDate.Day + KislevL 'כסלו

If HDate.Day < 1 Then HDate.Month = 2: HDate.Day = HDate.Day + HeshvanL 'חשוון

If HDate.Day < 1 Then HDate.Month = 1: HDate.Day = HDate.Day + 30 'תשרי

If HDate.Day < 1 Then HDate.Month = 0: HDate.Day = HDate.Day + 29

End If

'מציאת שמות היום, החודש והשנה

HDate.HDay = GetGimatrics(HDate.Day)

HDate.HMonth = GetMonthName(HDate.Month)

HDate.HYear = GetGimatrics(HDate.Year)

'בדוק אם יש חג החל באותו היום

HDate.Holiday = GetHoliday(HDate, GDate, KislevL)

GetHDate = HDate

End Function

'החזר את שם החג או המועד היהודי או העברי החל באותו היום

Function GetHoliday$(HDate As HDateType, ByVal GDate As Date, ByVal KislevL%)

'HDate 'התאריך העברי

'GDate 'התאריך הגרגוריאני

'(מספר הימים בחודש כסלו אותה השנה (לחישוב חנוכה

Dim CurWeekDay% 'היום בשבוע

Dim Holiday$

'חישוב היום בשבוע

CurWeekDay = WeekDay(GDate)

If HDate.Day = 1 And HDate.Month = 1 Then

Holiday = "ראש השנה א"

ElseIf HDate.Day = 2 And HDate.Month = 1 Then

Holiday = "ראש השנה ב"

ElseIf HDate.Day = 12 And HDate.Month = 1 Then

Holiday = "יום כיפור"

ElseIf HDate.Day = 15 And HDate.Month = 1 Then

Holiday = "סוכות א"

ElseIf HDate.Day >= 16 And HDate.Day <= 21 And HDate.Month = 1 Then

Holiday = "חהמ" + Chr$(34) + "ס"

ElseIf HDate.Day = 22 And HDate.Month = 1 Then

Holiday = "סוכות ב"

ElseIf Day(GDate) = 29 And Month(GDate) = 11 Then

Holiday = "כט בנובמבר"

ElseIf HDate.Month = 3 And HDate.Day >= 25 Then

Holiday = "חנוכה (" + Chr$(Asc("א") + HDate.Day - 25) + ")"

ElseIf HDate.Month = 4 And HDate.Day <= (32 - KislevL) Then

Holiday = "חנוכה (" + Chr$(Asc("ו") + HDate.Day + 30 - KislevL) + ")"

ElseIf HDate.Day = 15 And HDate.Month = 5 Then

Holiday = "טו בשבט"

ElseIf HDate.Day = 14 And (HDate.Month = 6 Or HDate.Month = 6.2) Then

Holiday = "פורים"

ElseIf HDate.Day = 15And (HDate.Month = 6 Or HDate.Month = 6.2) Then

Holiday = "שושן פורים"

ElseIf HDate.Day = 15 And HDate.Month = 7 Then

Holiday = "פסח"

ElseIf HDate.Day >= 16 And HDate.Day <= 21 And HDate.Month = 7 Then

Holiday = "חהמ" + Chr$(34) + "פ"

ElseIf HDate.Day = 22 And HDate.Month = 7 Then

Holiday = "פסח שני"

ElseIf HDate.Day = 15 And HDate.Month = 9 Then

Holiday = "שבועות"

ElseIf HDate.Day = 9 And HDate.Month = 11 Then

Holiday = "ט' באב"

End If

'חגים במועד לא קבוע

If HDate.Month = 7 Then 'בחודש ניסן

'יום השואה יחול במקרים הבאים: כז בניסן שאינו חמישי, שישי

'או שבת, כו בניסן שהוא יום רביעי או כח או כט בניסן שהם יום ראשון

If (HDate.Day = 27 And CurWeekDay < 5) Or (HDate.Day = 26 And CurWeekDay = 4) Or ((HDate.Day = 28 Or HDate.Day = 29) And CurWeekDay = 1) Then

Holiday = "יום השואה"

End If

ElseIf HDate.Month = 8 Then 'בחודש אייר

'יום העצמאות לא יחול בשישי, שבת או ראשון

'כלומר יחול במקרים הבאים: ה' באיר שאינו שישי שבת או ראשון

' ד' באייר שהוא יום חמישי או ו' או ז' באייר שהם יום ראשון

If (HDate.Day = 5 And CurWeekDay > 1 And CurWeekDay < 6) Or (HDate.Day = 4 And CurWeekDay = 5) Or ((HDate.Day = 6 Or HDate.Day = 7) And CurWeekDay = 2) Then

Holiday = "יום העצמאות"

End If

'יום הזיכרון יחול במקרים הבאים: ד באייר שאינו חמישי, שישי

'או שבת, ג באייר שהוא יום רביעי או ה או ו באייר שהם יום ראשון

If (HDate.Day = 4 And CurWeekDay < 5) Or (HDate.Day = 3 And CurWeekDay = 4) Or ((HDate.Day = 5 Or HDate.Day = 6) And CurWeekDay = 1) Then

Holiday = "יום הזיכרון"

End If

End If

GetHoliday = Holiday

End Function

'החזר את שם החודש העברי

Function GetMonthName$(ByVal Month)

Select Case Month

Case 1: GetMonthName$ = "תשרי"

Case 2: GetMonthName$ = "חשוון"

Case 3: GetMonthName$ = "כסלו"

Case 4: GetMonthName$ = "טבת"

Case 5: GetMonthName$ = "שבט"

Case 6: GetMonthName$ = "אדר"

Case 6.1: GetMonthName$ = "אדר א"

Case 6.2: GetMonthName$ = "אדר ב"

Case 7: GetMonthName$ = "ניסן"

Case 8: GetMonthName$ = "אייר"

Case 9: GetMonthName$ = "סיוון"

Case 10: GetMonthName$ = "תמוז"

Case 11: GetMonthName$ = "אב"

Case 12: GetMonthName$ = "אלול"

End Select

End Function

'החזר את התאריך היוליאני בו חל הפסח

'ל השנה העברית הנתונה

Function GetPDate(ByVal HYear%) As Date

Dim AA, MM, a, b, m, c 'משתנים לחישוב נוסחת גאוס

Dim PDate As Date

'חישוב התאריך היוליאני בו חל ט"ו בניסן לפי

'נוסחת גאוס

AA = HYear%

a = (12 * AA + 17) Mod 19

b = AA Mod 4

MM = Int(32.0441 + 1.55424 * a + 0.25 * b - 0.0031779 * AA)

m = (32.0441 + 1.55424 * a + 0.25 * b - 0.0031779 * AA) - MM

c = (MM + 3 * AA + 5 * b + 5) Mod 7

'תאריך הפסח הוא

PDate = DateSerial(AA - 3760, 3, MM)

'הדחיות

If c = 2 Or c = 4 Or c = 6 Then PDate = PDate + 1

If c = 1 And a > 6 And m >= 0.6329 Then PDate = PDate + 2

If c = 0 And a > 11 And m >= 0.8977 Then PDate = PDate + 1

GetPDate = PDate

End Function

'********************************************************************

'********************************************************************