פונקציות לתאריך עברי

דוד דוד · 26/8/18

האם משהו יודע איפה אפשר להשיג רשימה מסודרת של כל הפקודות בVBA
צירפתי לדוגמא קובץ של הפקודות הבסיסיות, לתועלת הכלל, וכדי שיבינו מה אני רוצה.
אשמח אם משהו ידוע איפה משיגים את הכל,
אני מניח שבספר של מחבר הקובץ הנ"ל יש הכל, אבל זה רק בקנייה בחנות...

תודה מראש
נ.ב. איך אני מפרסם הודעה זו לכל משתתפי פורום אופיס? הגבתי כאן כי לא ידעתי איך אני פותח הודעה חדשה לכלל המשתתפים.

דב פליי · 26/8/18

נכתב ע"י moishy:

ומה תאמר על זה:

קוד:

Function HebDateAdd(strInterval As String, dblNumber As Double, strDate As String)

    Dim i As Long, lngDayCounter As Long
    Dim lngHebYear As Long, lngHebMonth As Long, lngHebDay As Long
    Dim strTempDate As String
   
    Select Case DateType(strDate)
        Case 0
            ' לא תאריך
            HebDateAdd = ""
        Case 1
            ' תאריך לועזי
        Case 2
            ' תאריך עברי
            strDate = HebToDate(strDate)
    End Select
   
    Select Case strInterval
        Case Is = "י"
            strDate = DateAdd("d", dblNumber, strDate)
            HebDateAdd = DateToHeb(strDate)
        Case Is = "ח"
            strDate = HebToDate(strDate)
            GregToHeb strDate, lngHebYear, lngHebMonth, lngHebDay
   
            For i = 1 To dblNumber
                lngDayCounter = lngDayCounter + IIf(IsFullMonth(lngHebYear, lngHebMonth + i), 30, 29)
            Next

            strTempDate = DateAdd("d", lngDayCounter, strDate)
            HebDateAdd = DateToHeb(strTempDate)
        Case Else
            HebDateAdd = ""
    End Select

End Function

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

moishy · 26/8/18

נכתב ע"י חיים יודלביץ:
לצערי אני לא מסתדר עם הפונקצייה אני לא מצליח לכתוב לה פרמטרים.
האם הפרמטרים אמורים להיות כמו הגרסה הראשונה של הפונקצייה כלומר, חודש או יום, מספר חודשים קדימה, ותאריך עברי ממנו לחשב קדימה?
נסיתי לכתוב כמו הפרמטרים הנ"ל, שזה גם מה שהבנתי מתוך הקוד שאמור להיות, אבל האקסל כותב שגיאה "הערך שהזנתי ערך שאינו מתאים"
מעניין לציין שכאשר ההפניה היתה לתאים ריקים הוא כן כתב תאריך כל שהו ולא שגיאה.
אשמח לעזרה איזה פרמטרים אני אמור לכתוב

לדוגמא:
=HebDateAdd("ח", 1, "ל באב תשע''ח")

דב פליי · 26/8/18

נכתב ע"י moishy:
לדוגמא:
=HebDateAdd("ח", 1, "ל באב תשע''ח")

ככה אני כותב אבל במקום ה 1 אני נותן הפניה לדוגמא לתא A1 ובמקום לכתוב תאריך אני נותן הפניה לתא A2 וככה עד עכשיו זה עבד, מהשינוי בפונקצייה הוא מוציא את השגיאה הנ"ל

תודה רבה על כל העזרה!!

moishy · 26/8/18

זה עובד אצלי:

קוד:

Function HebDateAdd(strInterval As String, dblNumber As Double, strDate As String)

    Dim i As Long, lngDayCounter As Long
    Dim lngHebYear As Long, lngHebMonth As Long, lngHebDay As Long
    Dim strTempDate As String
    
    Select Case DateType(strDate)
        Case 0
            ' לא תאריך
            HebDateAdd = ""
        Case 1
            ' תאריך לועזי
        Case 2
            ' תאריך עברי
    End Select
    
    Select Case strInterval
        Case Is = "י"
            strDate = DateAdd("d", dblNumber, strDate)
            HebDateAdd = DateToHeb(strDate)
        Case Is = "ח"
            strDate = HebToDate(strDate)
            GregToHeb strDate, lngHebYear, lngHebMonth, lngHebDay
    
            For i = 1 To dblNumber
                lngDayCounter = lngDayCounter + IIf(IsFullMonth(lngHebYear, lngHebMonth + i), 30, 29)
            Next

            strTempDate = DateAdd("d", lngDayCounter, strDate)
            HebDateAdd = DateToHeb(strTempDate)
        Case Else
            HebDateAdd = ""
    End Select

End Function

דב פליי · 26/8/18

נכתב ע"י moishy:

זה עובד אצלי:

קוד:

Function HebDateAdd(strInterval As String, dblNumber As Double, strDate As String)

    Dim i As Long, lngDayCounter As Long
    Dim lngHebYear As Long, lngHebMonth As Long, lngHebDay As Long
    Dim strTempDate As String
   
    Select Case DateType(strDate)
        Case 0
            ' לא תאריך
            HebDateAdd = ""
        Case 1
            ' תאריך לועזי
        Case 2
            ' תאריך עברי
    End Select
   
    Select Case strInterval
        Case Is = "י"
            strDate = DateAdd("d", dblNumber, strDate)
            HebDateAdd = DateToHeb(strDate)
        Case Is = "ח"
            strDate = HebToDate(strDate)
            GregToHeb strDate, lngHebYear, lngHebMonth, lngHebDay
   
            For i = 1 To dblNumber
                lngDayCounter = lngDayCounter + IIf(IsFullMonth(lngHebYear, lngHebMonth + i), 30, 29)
            Next

            strTempDate = DateAdd("d", lngDayCounter, strDate)
            HebDateAdd = DateToHeb(strTempDate)
        Case Else
            HebDateAdd = ""
    End Select

End Function

גם אצלי, כרגע שמתי לב שאם אני כותב לו ל אב תשעח ושני חודשים קדימה הוא כותב לי א חשוון תשעט ולא ל תשרי תשעט סליחה על הבקשות המרובות, יש אפשרות לסדר גם את זה?
ושוב תודה רבה רבה על כל הטרחה והעזרה המרובה!!

דב פליי · 26/8/18

נכתב ע"י חיים יודלביץ:
גם אצלי, כרגע שמתי לב שאם אני כותב לו ל אב תשעח ושני חודשים קדימה הוא כותב לי א חשוון תשעט ולא ל תשרי תשעט סליחה על הבקשות המרובות, יש אפשרות לסדר גם את זה?
ושוב תודה רבה רבה על כל הטרחה והעזרה המרובה!!

עוד בעיה קטנה, אם אני כותב לו 5 חודשים קדימה אז הוא פתאום עובר ל ב שבט תשעט.

מקווה שאני לא משגע אותך...

יאיר משה · 27/8/18

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

משה מנחם · 27/8/18

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

moishy · 27/8/18

נכתב ע"י חיים יודלביץ:
עוד בעיה קטנה, אם אני כותב לו 5 חודשים קדימה אז הוא פתאום עובר ל ב שבט תשעט.

מקווה שאני לא משגע אותך...

יש כאן אתגר שצריך לפצח, אשמח לרעיונות.

האלגוריתם בגירסה האחרונה היתה:
1. להמיר את התאריך התחלה לתאריך לועזי במידה והוזן תאריך עברי
2. א. במידה ויחידת הזמן שנבחרה היא יום, להוסיף את מספר הימים לתאריך הלועזי
ב. במידה ויחידת הזמן שנבחרה היא חודש, לספור את הימים בכל החודשים, ולהוסיף אותם לתאריך הלועזי.
3. להמיר את התאריך הלועזי לתאריך עברי

האתגר הגדול הוא ב 2.ב., כיצד לבצע את זה אם יש מעבר שנה, או בשנה שאינה מעוברת מחודש אדר והלאה (וזאת בגלל שהפונקציה הבודקת אם חודש הוא מלא או חסר משתמש עם 13 חודשים, כאשר חודש 7 הוא קיים רק בשנה מעוברת).

FullTime · 27/8/18

@moishy
א. הוא אמור להיות ככה, לא?
For i = 0 To dblNumber - 1

ב. בשורה מתחתיו לא ציינת איזה ערך יחזיר ה IsFullMonth.

ג. אחרי חודש 13 ה IsFullMonth תמיד מחזיר 2.

FullTime · 28/8/18

@חיים יודלביץ @moishy

נ"ל שזה עובד טוב.

קוד:

Function HebDateAdd(strInterval As String, dblNumber As Double, strDate As String)

    Dim i As Long, lngDayCounter As Long
    Dim lngHebYear As Long, lngHebMonth As Long, lngHebDay As Long
    Dim strTempDate As String
    Dim boIsNotLeap As Boolean

    Select Case DateType(strDate)
    Case 0
        ' לא תאריך
        HebDateAdd = ""
    Case 1
        ' תאריך לועזי
    Case 2
        ' תאריך עברי
    End Select

    Select Case strInterval
    Case Is = "י"
        strDate = DateAdd("d", dblNumber, strDate)
        HebDateAdd = DateToHeb(strDate)
    Case Is = "ח"
        strDate = HebToDate(strDate)
        GregToHeb strDate, lngHebYear, lngHebMonth, lngHebDay

       For i = 0 To dblNumber - 1
           If lngHebMonth + i > 13 Then
               lngHebMonth = lngHebMonth - 13
               lngHebYear = lngHebYear + 1
           End If

           lngDayCounter = lngDayCounter + IIf(IsFullMonth(lngHebYear, lngHebMonth + i) = 1, 30, 29)
           
           If IsLeapYear(lngHebYear) = False And lngHebMonth + i = 7 Then lngDayCounter = lngDayCounter - 29: boIsNotLeap = True

       Next

       If boIsNotLeap Then
           lngDayCounter = lngDayCounter + IIf(IsFullMonth(lngHebYear, lngHebMonth + dblNumber) = 1, 30, 29)
       End If



        strTempDate = DateAdd("d", lngDayCounter, strDate)
        HebDateAdd = DateToHeb(strTempDate)
    Case Else
        HebDateAdd = ""
    End Select

End Function

FullTime · 28/8/18

נכתב ע"י יאיר משה:
מוישי, תודה רבה על הקודים הנפלאים. אפשר להוסיף אותם לאשכול קודים באקסס כדי שלא יעלמו במשך הזמן. כרגיל הקודים שלך נקיים ומעולים. ד"ש.

קריינא דאיגרתא..

moishy · 28/8/18

נכתב ע"י a26955:
@moishy
א. הוא אמור להיות ככה, לא?
For i = 0 To dblNumber - 1

ב. בשורה מתחתיו לא ציינת איזה ערך יחזיר ה IsFullMonth.

ג. אחרי חודש 13 ה IsFullMonth תמיד מחזיר 2.

א. אכן.
ב. ג. הייתי צריך להשתמש בפונקציה IsMonthFull ולא ב IsFullMonth

moishy · 28/8/18

נכתב ע"י a26955:

@חיים יודלביץ @moishy

נ"ל שזה עובד טוב.

קוד:

Function HebDateAdd(strInterval As String, dblNumber As Double, strDate As String)

    Dim i As Long, lngDayCounter As Long
    Dim lngHebYear As Long, lngHebMonth As Long, lngHebDay As Long
    Dim strTempDate As String

    Select Case DateType(strDate)
    Case 0
        ' לא תאריך
        HebDateAdd = ""
    Case 1
        ' תאריך לועזי
    Case 2
        ' תאריך עברי
    End Select

    Select Case strInterval
    Case Is = "י"
        strDate = DateAdd("d", dblNumber, strDate)
        HebDateAdd = DateToHeb(strDate)
    Case Is = "ח"
        strDate = HebToDate(strDate)
        GregToHeb strDate, lngHebYear, lngHebMonth, lngHebDay

        For i = 0 To dblNumber - 1
            If lngHebMonth + i > 13 Then
                lngHebMonth = lngHebMonth - 13
                lngHebYear = lngHebYear + 1
            End If


            lngDayCounter = lngDayCounter + IIf(IsFullMonth(lngHebYear, lngHebMonth + i) = 1, 30, 29)
     '       Debug.Print lngHebMonth + i & ": " & IsFullMonth(lngHebYear, lngHebMonth + i)
        Next

        strTempDate = DateAdd("d", lngDayCounter, strDate)
        HebDateAdd = DateToHeb(strTempDate)
    Case Else
        HebDateAdd = ""
    End Select

End Function

נהדר, שמח שפיצחת את זה

FullTime · 28/8/18

נכתב ע"י moishy:
ג. הייתי צריך להשתמש בפונקציה IsMonthFull ולא ב IsFullMonth

לג. הוא לא עזר, הוספתי לו If לפני ה For

FullTime · 28/8/18

נכתב ע"י moishy:
נהדר, שמח שפיצחת את זה

https://www.prog.co.il/threads/ייצוא-מאקסס.121745/
ההודעה האחרונה, לא כמוך אבל רחוק משם...

FullTime · 28/8/18

@moyshi הוספתי לו בית חולים מתחת לגשר

קוד:

        For i = 0 To dblNumber - 1
            If lngHebMonth + i > 13 Then
                lngHebMonth = lngHebMonth - 13
                lngHebYear = lngHebYear + 1
            End If

            lngDayCounter = lngDayCounter + IIf(IsFullMonth(lngHebYear, lngHebMonth + i) = 1, 30, 29)
            
            If IsLeapYear(lngHebYear) = False And lngHebMonth + i = 7 Then lngDayCounter = lngDayCounter - 29: boIsNotLeap = True

        Next

        If boIsNotLeap Then
            lngDayCounter = lngDayCounter + IIf(IsFullMonth(lngHebYear, lngHebMonth + dblNumber) = 1, 30, 29)
        End If

moishy · 28/8/18

נכתב ע"י a26955:

@moishy הוספתי לו בית חולים מתחת לגשר

קוד:

        For i = 0 To dblNumber - 1
            If lngHebMonth + i > 13 Then
                lngHebMonth = lngHebMonth - 13
                lngHebYear = lngHebYear + 1
            End If

            lngDayCounter = lngDayCounter + IIf(IsFullMonth(lngHebYear, lngHebMonth + i) = 1, 30, 29)
           
            If IsLeapYear(lngHebYear) = False And lngHebMonth + i = 7 Then lngDayCounter = lngDayCounter - 29: boIsNotLeap = True

        Next

        If boIsNotLeap Then
            lngDayCounter = lngDayCounter + IIf(IsFullMonth(lngHebYear, lngHebMonth + dblNumber) = 1, 30, 29)
        End If

למה?

FullTime · 28/8/18

נכתב ע"י moishy:
למה?

גם בשנה שאינה מעוברת היה סופר את חודש 7 כאחד מהחודשים,
הרי ה isfullmonth אינו מחזיר מספר ימים...
ותמיד היה מוסיף 29 לפעמים היה צולח ולפעמים לא.
וה for לא ספר את החודש האחרון

פונקציות לתאריך עברי

משתמש חדש

קבצים מצורפים

משתמש פעיל

משתמש סופר מקצוען

משתמש פעיל

משתמש סופר מקצוען

משתמש פעיל

משתמש פעיל

משתמש פעיל

משתמש מקצוען

משתמש סופר מקצוען

משתמש מקצוען

משתמש מקצוען

משתמש מקצוען

משתמש סופר מקצוען

משתמש סופר מקצוען

משתמש מקצוען

משתמש מקצוען

משתמש מקצוען

משתמש סופר מקצוען

משתמש מקצוען

פסח כשר ופרימיום!

תגיות נפוצות