semo.pa3x حساب الفرق بين الأوقات والتواريخ (سنة - شهر - اسبوع - ساعة - دقيقة - ثانية)

[SEMO.Pa3x]

السلام عليكم ورحمة الله وبركاته، كيف حالكم اخواني الأفاضل.

مبارك عليكم حلول شهر رمضان المبارك أعاده الله علينا وعليكم باليمن والخير والبركات.

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

سنة - شهر - اسبوع - ساعة - دقيقة - ثانية

سؤال: ما الفائدة من هذا الفنكشن؟ بالدرجة الأولى سيُفيد أصحاب برامج الأقساط والتقسيط لإحتساب فترات التأخير والإستحقاق وغيرها.

وربما هنالك استخدامات أخرى له، حسب احتياج كل شخص

الفنكشن:

Public Function MainElapsedTime(d1, d2) As String
    d1 = CDate(d1)
    d2 = CDate(d2)
    vSecs = DateDiff("s", [d1], [d2])
    MainElapsedTime = ElapsedTimeAsTextRecur(vSecs)
End Function

Public Function ElapsedTimeAsTextRecur(ByVal pvSecs, Optional ByVal pvSecBlock)
    'recursive time lapse given seconds
    Dim vTxt
    Dim iNum As Long
    Const kDAY = 86400
    Const kSECpYR = 31536000
    
    '60  sec    = 1 min   =  60         sec
    '60  min    = 1 hour  =  3,600      sec
    '24  hour   = 1 day   =  86,400     sec
    '07  days   = 1 week  =  604,800    sec
    '30  days   = 1 month =  25,92,000  sec
    '12  months = 1 year  =  31,536,000 sec
    
    'YEARS
    If IsMissing(pvSecBlock) Then pvSecBlock = kSECpYR
    iNum = pvSecs \ pvSecBlock
    
    Select Case pvSecBlock
        Case kSECpYR 'yr
            sUnit = "years"
            If iNum > 0 Then
                vTxt = iNum & " Years "
                pvSecs = pvSecs - (iNum * pvSecBlock)
            End If
            vTxt = vTxt & ElapsedTimeAsTextRecur(pvSecs, 2592000)
            
        Case 2592000 'MO
            sUnit = "months"
            If iNum > 0 Then
                If iNum > 11 Then iNum = 11
                vTxt = vTxt & iNum & " Months "
                pvSecs = pvSecs - (iNum * pvSecBlock)
            End If
            vTxt = vTxt & ElapsedTimeAsTextRecur(pvSecs, 604800)
            
        Case 604800 'WEEK
            sUnit = "weeks"
            If iNum > 0 Then
                If iNum > 3 Then iNum = 3
                vTxt = vTxt & iNum & " Weeks "
                pvSecs = pvSecs - (iNum * kDAY * 7)
            End If
            vTxt = vTxt & ElapsedTimeAsTextRecur(pvSecs, 86400)
            
        Case kDAY 'day
            sUnit = "days"
            If iNum > 0 Then
                vTxt = vTxt & iNum & " Days "
                pvSecs = pvSecs - (iNum * kDAY)
            End If
            vTxt = vTxt & ElapsedTimeAsTextRecur(pvSecs, 3600)
            
        Case 3600 'hrs
            sUnit = "hrs"
            If iNum > 23 Then iNum = 23
            If iNum > 0 Then
                vTxt = vTxt & iNum & " Hours "
                pvSecs = pvSecs - (iNum * pvSecBlock)
            End If
            vTxt = vTxt & ElapsedTimeAsTextRecur(pvSecs, 60)
            
        Case 60 'min
            sUnit = "mins"
            If iNum > 0 Then
                vTxt = vTxt & iNum & " Minutes "
                pvSecs = pvSecs - (iNum * pvSecBlock)
            End If
            vTxt = vTxt & ElapsedTimeAsTextRecur(pvSecs, 1)
            
        Case Else
            
            sUnit = "secs"
            If pvSecs > 0 Then vTxt = vTxt & pvSecs & " Seconds"
    End Select
    
    ElapsedTimeAsTextRecur = vTxt
End Function

 

الإستخدام بسيط جدا في الإستعلامات او في النماذج او التقارير كالآتي:

MainElapsedTime("Here your date", Date())

---------------------------------------------------
Example: MsgBox MainElapsedTime("6/3/2020", "14/4/2021")

النتيجة:

 

 

هنا انا قمت بمقارنة تاريخين فقط بدون أوقات، سأقوم الآن بمقارنة تاريخ مع وقت

MsgBox MainElapsedTime("2/02/2019 12:07:16 pm", "13/04/2021 1:08:6 am")

 

النتيجة:

 

للأمانة الكود ليس من كتابتي 100%، فقط انا قمت بالتعديل عليه ليصبح بشكل افضل..

تحياتي وانتضرو مفاجئتي في الموضوع القادم  

[ابوخليل]

شكرا ابا مهاب  وكل عام وانتم بخير 

[Ali Mohamed Ali]

بارك الله فيك استاذنا الكريم وكل عام وانتم جميعاً بخير

[jasimhamza]

جزاك الله خيرا أستاذنا وبارك الله فيك وجعلنا الله وإياك وجميع الإخوة من عتقاء شهر رمضان

[حربي العنزي]

 

 جزاك الله خيرا أستاذنا الفاضل وبارك الله فيك وجعلنا الله وإياك وجميع الإخوة بأتم الصحة والعافية وكل عام وانت بألف خير