طلب كود (تاريخ التسليم) دون حساب الاجازة الاسبوعية

[علــــي]

السلام عليكم

لدي طلب صغير لأخواني اصحاب الخبرة

محتاج كود يعطيني التاريخ المطلوب دون حساب يومي الويكند

مثلا

تاريخ البدء 23-11-2017 يوم الخميس

مدة التسليم (3 أيام)

المطلوب : تاريخ التسليم  تلقائيا يكون (28-11-2017)

أي أنه تجاوز تاريخ 24+25 لأنهم يومي الجمعة والسبت وبدء الحساب من تاريخ 26/11/2017 يوم الأحد كأول يوم في الاسبوع

 

 

وشكرا جزيل 

Database1.zip

[jjafferr]

وعليكم السلام

 

ولو ان هذه الطريقة لا تُعتبر الافضل ولا الاسرع ، ولكنها جيدة نظرا للأيام القليلة التي تتعامل معاها 

 

هذه الوحدة النمطية التي تقوم بالعمل:

Option Compare Database
Option Explicit


Function Working_Dates(From_D, To_Period, Excl_D)

    'From_D    = Start Date (i.e. 32/11/2017)
    'To_Period = Number of Days to Count
    'Excl_D    = Excluded days, like weekends (in our case Friday and Saturday)
    '
    '1 = Sunday
    '2 = Monday
    '3 = Tuesday
    '4 = Wednesday
    '5 = Thursday
    '6 = Friday
    '7 = Saturday
    '
    ' to call this Function:
    'Working_Dates(#23/11/2017#, 3, "67")
    'or
    'Working_Dates(Me.dateToday, Me.long, "67")
    '
    
    Dim ToDate As Date
    Dim i As Date
    
    'ما هو اليوم الاخير ، بدون استقطاع الاجازة
    ToDate = DateAdd("d", To_Period, From_D)
    
    'ابدا الحساب من اول يوم الى اليوم الاخير
    For i = From_D To ToDate
    
        'اذا كان هذا اليوم من ايام الاجازة
        If InStr(1, Excl_D, Weekday(i)) > 0 Then
            'اضف يوم الى اليوم الاخير
            ToDate = ToDate + 1
        End If
        
    Next i
 
    'ارسل اليوم الاخير الى النموذج
    Working_Dates = ToDate
    
End Function

.

ونناديها من النموذج ، من حدث "بعد تحديث التاريخ" مثلا ، هكذا:

Private Sub dateToday_AfterUpdate()
'Me.Text537.Value = Me.dateToday + Me.long
'Me.Text537.Requery

    '1 = Sunday
    '2 = Monday
    '3 = Tuesday
    '4 = Wednesday
    '5 = Thursday
    '6 = Friday
    '7 = Saturday

    Me.DateOfFinish = Working_Dates(Me.dateToday, Me.long, "67")
    
End Sub

 

جعفر

 

742.Working_Days.accdb.zip

[علــــي]

جاري التجربة وشكرا يا استاذ دائما من بعد الله سبحانه تكون عون لنا

تحياتي والله يوفقك ويرزقك ما تتمنى

[علــــي]

السلام عليكم اخوي جعفر

أولاُ يعطيك العافية

الكود شغال بنسبة 80% لانه يوجد به خطأ وهو أن لما يكون تاريخ الانتهاء يصادف يوم "الجمعة" يحدث الخطأ ويحسب تاريخ يوم السبت أي لا يتجاوز ذلك

مثال ذلك لو كان تاريخ البدء 22/11/2017 والمدة 5 أيام يكون تاريخ الانتهاء 29/11/2017 المعادلة صحيحة تجاوز 24 الجمعة و 25 السبت

لكن لو كان تاريخ البدء 19/11/2017 والمدة 5 أيام يكون تاريخ الانتهاء 25/11/2017 المعادلة غير صحيحة تجاوز 24 الجمعة وتم حساب تاريخ 25 يوم السبت

مثال آخر لو كان تاريخ البدء 21/11/2017 والمدة 3 أيام يكون تاريخ الانتهاء 25/11/2017 المعادلة غير صحيحة تجاوز 24 الجمعة وتم حساب تاريخ 25 يوم السبت كذلك

 

أعتقد والله أعلم وانت أخبر مني أن الخطأ ربما يكون في الكود أنه يضيف يوم واحد ففي بعض الحلات يتم حساب يوم السبت

        'إذا كان اليوم من أيام الاجازة
        If InStr(1, Excl_D, Weekday(i)) > 0 Then
            'اضف يوم الى اليوم الاخير
            ToDate = ToDate + 1
        End If

شاكر لك وقتك وجهدك وتقبل تحياتي

[jjafferr]

وعليكم السلام اخوي علي

 

وشكرا على الرد المفصّل الواضح ، و بأمثلة 

 

هذا الكود هو العقل المدبر للوحدة كلها ، فلا تستهين فيه

اقتباس

        'إذا كان اليوم من أيام الاجازة
        If InStr(1, Excl_D, Weekday(i)) > 0 Then
            'اضف يوم الى اليوم الاخير
            ToDate = ToDate + 1
        End If

.

ولتعديل المطلوب ، تم اضافة سطرين كود في نهاية الوحدة النمطية:

Option Compare Database
Option Explicit

Function Working_Dates(From_D, To_Period, Excl_D)

    'From_D    = Start Date (i.e. 32/11/2017)
    'To_Period = Number of Days to Count
    'Excl_D    = Excluded days, like weekends (in our case Friday and Saturday)
    '
    '1 = Sunday
    '2 = Monday
    '3 = Tuesday
    '4 = Wednesday
    '5 = Thursday
    '6 = Friday
    '7 = Saturday
    '
    ' to call this Function:
    'Working_Dates(#23/11/2017#, 3, "67")
    'or
    'Working_Dates(Me.dateToday, Me.long, "67")
    '
    
    Dim ToDate As Date
    Dim i As Date
    
    'ما هو اليوم الاخير ، بدون استقطاع الاجازة
    ToDate = DateAdd("d", To_Period, From_D)
    
    'ابدا الحساب من اول يوم الى اليوم الاخير
    For i = From_D To ToDate
    
        'اذا كان هذا اليوم من ايام الاجازة
        If InStr(1, Excl_D, Weekday(i)) > 0 Then
            'اضف يوم الى اليوم الاخير
            ToDate = ToDate + 1
        End If
        
    Next i
 
    'اذا كان اليوم الاخير يقع في اجازة (الاجازة يومين)
    If InStr(1, Excl_D, Weekday(ToDate)) > 0 Then: ToDate = ToDate + 1
    If InStr(1, Excl_D, Weekday(ToDate)) > 0 Then: ToDate = ToDate + 1
    
    'ارسل اليوم الاخير الى النموذج
    Working_Dates = ToDate
    
End Function

.

جعفر

742.Working_Days.accdb.zip

[علــــي]

والله مب مستهين فيه مبين انه كود خطير هههههههههه

طبعا مهما وصلنا من مستوى تبقى انت الكبير والاستاذ وهذا احنا نتعلم منك يا اخوي جعفر

جاري التجربة ٫٫٫٫٫

وشكراً وتآكد ان هذا المنتدى يمتلك مواهب ما شاء الله عليها <<<<اتمنى لكم التوفيق يارب