אופיס 365 תאריך עברי באקסס

[ארי4791]

האם יש למישהו קוד להמרת תאריך לועזי לעברי, שגם מתחשב אחרי השקיעה בתאריך החדש?
תודה רבה מאוד

 

[moishy]

1. תאריך לועזי לא כולל שעה.
2. תאריך לועזי לא כולל מיקום.

איך אתה מצפה להתחשב בנתונים שלא קיימים בעת המרת תאריך?

 

[ארי4791]

צודק.
אני צריך קוד שיודע להוסיף ימים וחודשים לתאריך עברי, יש דבר כזה?

 

[moishy]

הוספת ימים פשוטה, כל מה שצריך לעשות זה להוסיף יום לתאריך הלועזי לפני ההמרה באמצעות DateAdd. כנ"ל לגבי הוספת חודשים לועזיים.

להוספת חודשים עבריים לתאריך לועזי פירסמתי קוד בעבר (יש צורך בשאר הקוד הנמצא באשכול השכן, זה הפונקציה שמוסיפה חודשים עבריים לתאריך הלועזי):

Function HebrewDateAdd(dtDate As Date, lngMonths As Long) As String

    Dim lngHebYear As Long
    Dim lngHebMonth As Long
    Dim lngHebDay As Long
    Dim lngTotalMonths As Long
    Dim lngLengthOfYear As Long
    Dim blnLeapYear As Boolean
    Dim blnHaser As Boolean
    Dim blnShalem As Boolean

    GregToHeb dtDate, lngHebYear, lngHebMonth, lngHebDay
    lngLengthOfYear = LengthOfYear(lngHebYear)
    blnHaser = lngLengthOfYear = 353 Or lngLengthOfYear = 383
    blnShalem = lngLengthOfYear = 355 Or lngLengthOfYear = 385
    lngTotalMonths = lngMonths + lngHebMonth

    Do While lngTotalMonths > 13
        lngHebYear = lngHebYear + 1
        blnLeapYear = IsLeapYear(lngHebYear)
        lngTotalMonths = lngTotalMonths - IIf(blnLeapYear, 13, 12)
    Loop

    blnLeapYear = IsLeapYear(lngHebYear)

    If lngHebDay = 30 Then
        Select Case lngTotalMonths
            Case 1, 5, 8, 10, 12
                lngHebDay = 30
            Case 4, 7, 9, 11, 13
                lngHebDay = 1
                lngTotalMonths = IIf(lngTotalMonths = 13, 1, lngTotalMonths + 1)
                lngHebYear = IIf(lngTotalMonths > 13, lngHebYear + Int(lngTotalMonths / 13), lngHebYear)
            Case 6
            Case 2
                lngHebDay = IIf(Not blnShalem, 1, 30)
                lngHebMonth = IIf(Not blnShalem, lngHebMonth + 1, lngHebMonth)
            Case 3
                lngHebDay = IIf(blnHaser, 1, 30)
                lngHebMonth = IIf(blnHaser, lngHebMonth + 1, lngHebMonth)
        End Select
    End If

    HebrewDateAdd = FormatDateH(lngHebYear, lngTotalMonths, lngHebDay)

End Function

הפונקציה מקבלת שני פרמטרים, התאריך הלועזי ומספר החודשים העבריים להוסיף לו. הפונקציה מחזירה תאריך עברי.