اذهب الي المحتوي
أوفيسنا

وحدة لحساب الفرق بين تاريخين بالسنين و الشهور و الايام

ِAbo_El_Ela

بواسطه ِAbo_El_Ela
في قسم الأكسيس Access

 مشاركة

الردود الموصى بها

ِAbo_El_Ela

ِAbo_El_Ela

قام بنشر
قام بنشر (معدل)

لقد قمت بعمل مديول لحساب الفرق بين تاريخين بالسنة و الشهر و الايام 

السنة في خانة 

الشهور في خانة 

الايام في خانة 

و قمت بالتجربة و ان شاء الله ناجحة 

و اليكم محتويات المديول للتجربة و كتابة الملاحظات لتعم الفائدة 

Function DatDiffY(Vdate1 As Date, Vdate2 As Date) As Integer

Dim year1 As Integer
Dim year2 As Integer
Dim year3 As Integer
Dim month1 As Integer
Dim month2 As Integer
Dim month3 As Integer
Dim day1 As Integer
Dim day2 As Integer
    year1 = Int(DatePart("yyyy", Vdate1))
    year2 = Int(DatePart("yyyy", Vdate2))
        month1 = Int(DatePart("m", Vdate1))
        month2 = Int(DatePart("m", Vdate2))
            day1 = Int(DatePart("d", Vdate1))
            day2 = Int(DatePart("d", Vdate2))
If month2 < month1 Or day2 < day1 Then
    If (year2 - year1) - 1 < 0 Then
    DatDiffY = 0
    Else
    DatDiffY = (year2 - year1) - 1
    End If
Else
    DatDiffY = year2 - year1
End If
End Function

Function DatDiffM(Vdate1 As Date, Vdate2 As Date) As Integer

Dim day1 As Integer
Dim day2 As Integer
Dim month1 As Integer
Dim month2 As Integer
Dim month3 As Integer
Dim year1 As Integer
Dim year2 As Integer
Dim dateC1 As Date
    day1 = Int(DatePart("d", Vdate1))
    day2 = Int(DatePart("d", Vdate2))
        month1 = Int(DatePart("m", Vdate1))
        month2 = Int(DatePart("m", Vdate2))
            year1 = Int(DatePart("yyyy", Vdate1))
            year2 = Int(DatePart("yyyy", Vdate2))
If month2 < month1 Or day2 < day1 Then
    If month2 < month1 And day2 > day1 Then
    month3 = month2 + 12
    DatDiffM = (month3 - month1)
    End If
    
    If month2 < month1 And day2 < day1 Then
    month3 = (month2 + 12) - 1
        If (month3 - month1) - 1 < 0 Then
        DatDiffM = 0
        Else
        DatDiffM = (month3 - month1)
        End If
    End If

    If month2 > month1 And day2 < day1 Then
    DatDiffM = (month2 - month1) - 1
    End If
Else
DatDiffM = month2 - month1
End If


End Function

Function DatDiffD(Vdate1 As Date, Vdate2 As Date) As Integer

Dim day1 As Integer
Dim day2 As Integer
Dim month1 As Integer
Dim month2 As Integer
Dim month3 As Integer
Dim year1 As Integer
Dim year2 As Integer
Dim year3 As Integer
Dim dateC1 As Date
    day1 = Int(DatePart("d", Vdate1))
    day2 = Int(DatePart("d", Vdate2))
        month1 = Int(DatePart("m", Vdate1))
        month2 = Int(DatePart("m", Vdate2))
            year1 = Int(DatePart("yyyy", Vdate1))
            year2 = Int(DatePart("yyyy", Vdate2))

If day2 < day1 Then
month3 = month2 - 1
dateC1 = DateSerial(year2, month3, day1)
DatDiffD = DateDiff("d", dateC1, Vdate2)
Else
DatDiffD = day2 - day1
End If
End Function
 

و هذه هي طريقة الاستدعاء 

Me.text3 = DatDiffY(Me.text1, Me.text2)
Me.text4 = DatDiffM(Me.text1, Me.text2)
Me.text5 = DatDiffD(Me.text1, Me.text2)

تم تعديل بواسطه ABOLO2
  • Thanks 1
Moosak

Moosak

قام بنشر
قام بنشر (معدل)

شكرا لك أخي @ABOLO2 🙂  على هذا المجهود الطيب ..

ملاحظة :

جرب استخدام هذا الخيار من لوحة التنسيق لإرفاق الأكواد  : image.png.ff87b361a9c8eac51ad3308f14fb7dce.png

وستظهر لك بهذه الطريقة المنظمة والجميلة 🙂 : 

Sub test()
'و هذه هي طريقة الاستدعاء
Debug.Print DatDiffY(#1/1/2020#, Date)  ' السنوات
Debug.Print DatDiffM(#1/1/2020#, Date)  ' الأشهر
Debug.Print DatDiffD(#1/1/2020#, Date)  ' الأيام

End Sub


Function DatDiffY(Vdate1 As Date, Vdate2 As Date) As Integer

Dim year1 As Integer
Dim year2 As Integer
Dim year3 As Integer
Dim month1 As Integer
Dim month2 As Integer
Dim month3 As Integer
Dim day1 As Integer
Dim day2 As Integer
    year1 = Int(DatePart("yyyy", Vdate1))
    year2 = Int(DatePart("yyyy", Vdate2))
        month1 = Int(DatePart("m", Vdate1))
        month2 = Int(DatePart("m", Vdate2))
            day1 = Int(DatePart("d", Vdate1))
            day2 = Int(DatePart("d", Vdate2))
If month2 < month1 Or day2 < day1 Then
    If (year2 - year1) - 1 < 0 Then
    DatDiffY = 0
    Else
    DatDiffY = (year2 - year1) - 1
    End If
Else
    DatDiffY = year2 - year1
End If
End Function

Function DatDiffM(Vdate1 As Date, Vdate2 As Date) As Integer

Dim day1 As Integer
Dim day2 As Integer
Dim month1 As Integer
Dim month2 As Integer
Dim month3 As Integer
Dim year1 As Integer
Dim year2 As Integer
Dim dateC1 As Date
    day1 = Int(DatePart("d", Vdate1))
    day2 = Int(DatePart("d", Vdate2))
        month1 = Int(DatePart("m", Vdate1))
        month2 = Int(DatePart("m", Vdate2))
            year1 = Int(DatePart("yyyy", Vdate1))
            year2 = Int(DatePart("yyyy", Vdate2))
If month2 < month1 Or day2 < day1 Then
    If month2 < month1 And day2 > day1 Then
    month3 = month2 + 12
    DatDiffM = (month3 - month1)
    End If
    
    If month2 < month1 And day2 < day1 Then
    month3 = (month2 + 12) - 1
        If (month3 - month1) - 1 < 0 Then
        DatDiffM = 0
        Else
        DatDiffM = (month3 - month1)
        End If
    End If

    If month2 > month1 And day2 < day1 Then
    DatDiffM = (month2 - month1) - 1
    End If
Else
DatDiffM = month2 - month1
End If


End Function

Function DatDiffD(Vdate1 As Date, Vdate2 As Date) As Integer

Dim day1 As Integer
Dim day2 As Integer
Dim month1 As Integer
Dim month2 As Integer
Dim month3 As Integer
Dim year1 As Integer
Dim year2 As Integer
Dim year3 As Integer
Dim dateC1 As Date
    day1 = Int(DatePart("d", Vdate1))
    day2 = Int(DatePart("d", Vdate2))
        month1 = Int(DatePart("m", Vdate1))
        month2 = Int(DatePart("m", Vdate2))
            year1 = Int(DatePart("yyyy", Vdate1))
            year2 = Int(DatePart("yyyy", Vdate2))

If day2 < day1 Then
month3 = month2 - 1
dateC1 = DateSerial(year2, month3, day1)
DatDiffD = DateDiff("d", dateC1, Vdate2)
Else
DatDiffD = day2 - day1
End If
End Function

 

تم تعديل بواسطه Moosak
  • Thanks 1
ِAbo_El_Ela

ِAbo_El_Ela

قام بنشر
  • الكاتب
قام بنشر
1 ساعه مضت, Moosak said:

شكرا لك أخي @ABOLO2 🙂  على هذا المجهود الطيب ..

ملاحظة :

جرب استخدام هذا الخيار من لوحة التنسيق لإرفاق الأكواد  : image.png.ff87b361a9c8eac51ad3308f14fb7dce.png

وستظهر لك بهذه الطريقة المنظمة والجميلة 🙂 : 

Sub test()
'و هذه هي طريقة الاستدعاء
Debug.Print DatDiffY(#1/1/2020#, Date)  ' السنوات
Debug.Print DatDiffM(#1/1/2020#, Date)  ' الأشهر
Debug.Print DatDiffD(#1/1/2020#, Date)  ' الأيام

End Sub


Function DatDiffY(Vdate1 As Date, Vdate2 As Date) As Integer

Dim year1 As Integer
Dim year2 As Integer
Dim year3 As Integer
Dim month1 As Integer
Dim month2 As Integer
Dim month3 As Integer
Dim day1 As Integer
Dim day2 As Integer
    year1 = Int(DatePart("yyyy", Vdate1))
    year2 = Int(DatePart("yyyy", Vdate2))
        month1 = Int(DatePart("m", Vdate1))
        month2 = Int(DatePart("m", Vdate2))
            day1 = Int(DatePart("d", Vdate1))
            day2 = Int(DatePart("d", Vdate2))
If month2 < month1 Or day2 < day1 Then
    If (year2 - year1) - 1 < 0 Then
    DatDiffY = 0
    Else
    DatDiffY = (year2 - year1) - 1
    End If
Else
    DatDiffY = year2 - year1
End If
End Function

Function DatDiffM(Vdate1 As Date, Vdate2 As Date) As Integer

Dim day1 As Integer
Dim day2 As Integer
Dim month1 As Integer
Dim month2 As Integer
Dim month3 As Integer
Dim year1 As Integer
Dim year2 As Integer
Dim dateC1 As Date
    day1 = Int(DatePart("d", Vdate1))
    day2 = Int(DatePart("d", Vdate2))
        month1 = Int(DatePart("m", Vdate1))
        month2 = Int(DatePart("m", Vdate2))
            year1 = Int(DatePart("yyyy", Vdate1))
            year2 = Int(DatePart("yyyy", Vdate2))
If month2 < month1 Or day2 < day1 Then
    If month2 < month1 And day2 > day1 Then
    month3 = month2 + 12
    DatDiffM = (month3 - month1)
    End If
    
    If month2 < month1 And day2 < day1 Then
    month3 = (month2 + 12) - 1
        If (month3 - month1) - 1 < 0 Then
        DatDiffM = 0
        Else
        DatDiffM = (month3 - month1)
        End If
    End If

    If month2 > month1 And day2 < day1 Then
    DatDiffM = (month2 - month1) - 1
    End If
Else
DatDiffM = month2 - month1
End If


End Function

Function DatDiffD(Vdate1 As Date, Vdate2 As Date) As Integer

Dim day1 As Integer
Dim day2 As Integer
Dim month1 As Integer
Dim month2 As Integer
Dim month3 As Integer
Dim year1 As Integer
Dim year2 As Integer
Dim year3 As Integer
Dim dateC1 As Date
    day1 = Int(DatePart("d", Vdate1))
    day2 = Int(DatePart("d", Vdate2))
        month1 = Int(DatePart("m", Vdate1))
        month2 = Int(DatePart("m", Vdate2))
            year1 = Int(DatePart("yyyy", Vdate1))
            year2 = Int(DatePart("yyyy", Vdate2))

If day2 < day1 Then
month3 = month2 - 1
dateC1 = DateSerial(year2, month3, day1)
DatDiffD = DateDiff("d", dateC1, Vdate2)
Else
DatDiffD = day2 - day1
End If
End Function

 

تسلم استاذي موسي 

اشكرك شكرا جزيلا

ِAbo_El_Ela

ِAbo_El_Ela

قام بنشر
  • الكاتب
قام بنشر

الكود بعد التعديل  

 

Function DatDiffY(Vdate1 As Date, Vdate2 As Date) As Integer

Dim year1 As Integer
Dim year2 As Integer
Dim year3 As Integer
Dim month1 As Integer
Dim month2 As Integer
Dim month3 As Integer
Dim day1 As Integer
Dim day2 As Integer
    year1 = Int(DatePart("yyyy", Vdate1))
    year2 = Int(DatePart("yyyy", Vdate2))
        month1 = Int(DatePart("m", Vdate1))
        month2 = Int(DatePart("m", Vdate2))
            day1 = Int(DatePart("d", Vdate1))
            day2 = Int(DatePart("d", Vdate2))
If month2 < month1 Or day2 < day1 Then
    If (year2 - year1) - 1 < 0 Then
    DatDiffY = 0
    Else
    DatDiffY = (year2 - year1) - 1
    End If
Else
    DatDiffY = year2 - year1
End If
End Function

Function DatDiffM(Vdate1 As Date, Vdate2 As Date) As Integer

Dim day1 As Integer
Dim day2 As Integer
Dim month1 As Integer
Dim month2 As Integer
Dim month3 As Integer
Dim year1 As Integer
Dim year2 As Integer
Dim dateC1 As Date
    day1 = Int(DatePart("d", Vdate1))
    day2 = Int(DatePart("d", Vdate2))
        month1 = Int(DatePart("m", Vdate1))
        month2 = Int(DatePart("m", Vdate2))
            year1 = Int(DatePart("yyyy", Vdate1))
            year2 = Int(DatePart("yyyy", Vdate2))
If month2 < month1 Or day2 < day1 Then
    If month2 < month1 And day2 >= day1 Then
    month3 = month2 + 12
    DatDiffM = (month3 - month1)
    End If
    
    If month2 < month1 And day2 < day1 Then
    month3 = (month2 + 12) - 1
        If (month3 - month1) - 1 < 0 Then
        DatDiffM = 0
        Else
        DatDiffM = (month3 - month1)
        End If
    End If

    If month2 > month1 And day2 < day1 Then
    DatDiffM = (month2 - month1) - 1
    End If
Else
DatDiffM = month2 - month1
End If


End Function

Function DatDiffD(Vdate1 As Date, Vdate2 As Date) As Integer

Dim day1 As Integer
Dim day2 As Integer
Dim month1 As Integer
Dim month2 As Integer
Dim month3 As Integer
Dim year1 As Integer
Dim year2 As Integer
Dim year3 As Integer
Dim dateC1 As Date
    day1 = Int(DatePart("d", Vdate1))
    day2 = Int(DatePart("d", Vdate2))
        month1 = Int(DatePart("m", Vdate1))
        month2 = Int(DatePart("m", Vdate2))
            year1 = Int(DatePart("yyyy", Vdate1))
            year2 = Int(DatePart("yyyy", Vdate2))

If day2 < day1 Then
month3 = month2 - 1
dateC1 = DateSerial(year2, month3, day1)
DatDiffD = DateDiff("d", dateC1, Vdate2)
Else
DatDiffD = day2 - day1
End If
End Function

 

  • 4 weeks later...
ِAbo_El_Ela

ِAbo_El_Ela

قام بنشر
  • الكاتب
قام بنشر

للاسف المديول السابق كان فيه اخطاء في السنة و الايام كان فيهم اخطاء 

و عدلته الي الاتي 

Option Compare Database
Option Explicit

Function DatDiffY(Vdate1 As Date, Vdate2 As Date) As Integer

Dim year1 As Integer
Dim year2 As Integer
Dim year3 As Integer
Dim month1 As Integer
Dim month2 As Integer
Dim month3 As Integer
Dim day1 As Integer
Dim day2 As Integer
    year1 = Int(DatePart("yyyy", Vdate1))
    year2 = Int(DatePart("yyyy", Vdate2))
        month1 = Int(DatePart("m", Vdate1))
        month2 = Int(DatePart("m", Vdate2))
            day1 = Int(DatePart("d", Vdate1))
            day2 = Int(DatePart("d", Vdate2))
If month2 < month1 Or day2 < day1 Then
    If month2 < month1 And day2 < day1 Then
        If (year2 - year1) - 1 < 0 Then
        DatDiffY = 0
        Else
        DatDiffY = (year2 - year1) - 1
        Debug.Print DatDiffY
        End If
    End If

    If month2 < month1 And day2 > day1 Then
        If (year2 - year1) - 1 < 0 Then
        DatDiffY = 0
        Else
        DatDiffY = (year2 - year1) - 1
        Debug.Print DatDiffY
        End If
    End If

Else
    DatDiffY = year2 - year1
End If
End Function

Function DatDiffM(Vdate1 As Date, Vdate2 As Date) As Integer

Dim day1 As Integer
Dim day2 As Integer
Dim month1 As Integer
Dim month2 As Integer
Dim month3 As Integer
Dim year1 As Integer
Dim year2 As Integer
Dim dateC1 As Date
    day1 = Int(DatePart("d", Vdate1))
    day2 = Int(DatePart("d", Vdate2))
        month1 = Int(DatePart("m", Vdate1))
        month2 = Int(DatePart("m", Vdate2))
            year1 = Int(DatePart("yyyy", Vdate1))
            year2 = Int(DatePart("yyyy", Vdate2))
If month2 < month1 Or day2 < day1 Then
    If month2 < month1 And day2 >= day1 Then
    month3 = month2 + 12
    DatDiffM = (month3 - month1)
    End If

    If month2 < month1 And day2 < day1 Then
    month3 = (month2 + 12) - 1
        If (month3 - month1) - 1 < 0 Then
        DatDiffM = 0
        Else
        DatDiffM = (month3 - month1)
        End If
    End If

    If month2 > month1 And day2 < day1 Then
    month3 = month2 - 1
    DatDiffM = (month3 - month1)
    End If

Else
DatDiffM = month2 - month1
End If


End Function

Function DatDiffD(Vdate1 As Date, Vdate2 As Date) As Integer

Dim day1 As Integer
Dim day2 As Integer
Dim tt As Integer
Dim yy As Integer
Dim month1 As Integer
Dim month2 As Integer
Dim month3 As Integer
Dim year1 As Integer
Dim year2 As Integer
Dim year3 As Integer
Dim dateC1 As Date
    day1 = Int(DatePart("d", Vdate1))
    day2 = Int(DatePart("d", Vdate2))
        month1 = Int(DatePart("m", Vdate1))
        month2 = Int(DatePart("m", Vdate2))
            year1 = Int(DatePart("yyyy", Vdate1))
            year2 = Int(DatePart("yyyy", Vdate2))
            
If day2 < day1 Then
tt = DateSerial(year1, month1 + 1, "1") - Vdate1
yy = Vdate2 - DateSerial(year2, month2, "1")
DatDiffD = tt + yy
Else
DatDiffD = day2 - day1
End If
End Function

 

ِAbo_El_Ela

ِAbo_El_Ela

قام بنشر
  • الكاتب
قام بنشر

اخر تعديل بأذن الله 😂 

Option Compare Database
Option Explicit

Function DatDiffY(Vdate1 As Date, Vdate2 As Date) As Integer

Dim year1 As Integer
Dim year2 As Integer
Dim year3 As Integer
Dim month1 As Integer
Dim month2 As Integer
Dim month3 As Integer
Dim day1 As Integer
Dim day2 As Integer
    year1 = Int(DatePart("yyyy", Vdate1))
    year2 = Int(DatePart("yyyy", Vdate2))
        month1 = Int(DatePart("m", Vdate1))
        month2 = Int(DatePart("m", Vdate2))
            day1 = Int(DatePart("d", Vdate1))
            day2 = Int(DatePart("d", Vdate2))
If month2 < month1 Or day2 < day1 Then
    If month2 < month1 And day2 < day1 Then
        If (year2 - year1) - 1 < 0 Then
        DatDiffY = 0
        Else
        DatDiffY = (year2 - year1) - 1
        End If
    End If

    If month2 < month1 And day2 > day1 Then
        If (year2 - year1) - 1 < 0 Then
        DatDiffY = 0
        Else
        DatDiffY = (year2 - year1) - 1
        End If
    End If

Else
    DatDiffY = year2 - year1
End If
End Function

Function DatDiffM(Vdate1 As Date, Vdate2 As Date) As Integer

Dim day1 As Integer
Dim day2 As Integer
Dim month1 As Integer
Dim month2 As Integer
Dim month3 As Integer
Dim year1 As Integer
Dim year2 As Integer
Dim dateC1 As Date
    day1 = Int(DatePart("d", Vdate1))
    day2 = Int(DatePart("d", Vdate2))
        month1 = Int(DatePart("m", Vdate1))
        month2 = Int(DatePart("m", Vdate2))
            year1 = Int(DatePart("yyyy", Vdate1))
            year2 = Int(DatePart("yyyy", Vdate2))
If month2 < month1 Or day2 < day1 Then
    If month2 < month1 And day2 >= day1 Then
    month3 = month2 + 12
    DatDiffM = (month3 - month1)
    End If

    If month2 < month1 And day2 < day1 Then
    month3 = (month2 + 12) - 1
        If (month3 - month1) - 1 < 0 Then
        DatDiffM = 0
        Else
        DatDiffM = (month3 - month1)
        End If
    End If

    If month2 > month1 And day2 < day1 Then
    month3 = month2 - 1
    DatDiffM = (month3 - month1)
    End If

Else
DatDiffM = month2 - month1
End If


End Function

Function DatDiffD(Vdate1 As Date, Vdate2 As Date) As Integer

Dim day1 As Integer
Dim day2 As Integer
Dim tt As Integer
Dim yy As Integer
Dim uu As Date
Dim month1 As Integer
Dim month2 As Integer
Dim month3 As Integer
Dim year1 As Integer
Dim year2 As Integer
Dim year3 As Integer
Dim dateC1 As Date
    day1 = Int(DatePart("d", Vdate1))
    day2 = Int(DatePart("d", Vdate2))
        month1 = Int(DatePart("m", Vdate1))
        month2 = Int(DatePart("m", Vdate2))
            year1 = Int(DatePart("yyyy", Vdate1))
            year2 = Int(DatePart("yyyy", Vdate2))
            
If day2 < day1 Then
uu = (DateSerial(year1, month1 + 1, "1") - 1)
tt = uu - Vdate1
yy = Vdate2 - DateSerial(year2, month2, "1")
If yy = 0 Then
yy = 1
End If
DatDiffD = tt + yy
Else
DatDiffD = day2 - day1
End If
End Function

 

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
 مشاركة
الذهاب الي قائمه المواضيع

  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information

  I accept