اذهب الي المحتوي
بحث مخصص من جوجل فى أوفيسنا
Custom Search
علــــي

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

Recommended Posts

السلام عليكم

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

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

مثلا

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

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

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

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

 

 

وشكرا جزيل 

Database1.zip

شارك هذه المشاركه


رابط المشاركه
شارك

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

 

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

 

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

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

  • Like 1

شارك هذه المشاركه


رابط المشاركه
شارك

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

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

شارك هذه المشاركه


رابط المشاركه
شارك

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

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

الكود شغال بنسبة 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

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

Untitled.jpg

شارك هذه المشاركه


رابط المشاركه
شارك

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

 

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

 

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

اقتباس

        'إذا كان اليوم من أيام الاجازة
        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

  • Like 1

شارك هذه المشاركه


رابط المشاركه
شارك

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

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

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

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

شارك هذه المشاركه


رابط المشاركه
شارك

انشئ حساب جديد او قم بتسجيل دخولك لتتمكن من اضافه تعليق جديد

يجب ان تكون عضوا لدينا لتتمكن من التعليق

انشئ حساب جديد

سجل حسابك الجديد لدينا في الموقع بمنتهي السهوله .

سجل حساب جديد

تسجيل دخول

هل تمتلك حساب بالفعل ؟ سجل دخولك من هنا.

سجل دخولك الان


  • المتواجدين الان   0 اعضاء متواجدين الان

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

×