AbuuAhmed

حياك الله عزيزي تحتاج تحترز ... بحيث إذا كان الوقت الحالي أكبر من وقت نهاية التشغيل تجعل حقول النتائج فاضية.

وعليكم السلام ورحمة الله وبركاته محاولتي تم تبديل المرفق لأن عملية الطرح كانت معكوسة. WorkTime_02.accdb

الدالة الآن أكثر مرونة، إذا أردناها كما الاكسل تماما يجب أن نجعل قيمة المدخل CompatibleWithExcel تساوي نعم True وبترك هذا المدخل أو جعل قيمته لا False سوف تقوم الدالة بالتالي: - اعتماد تاريخ البداية ضمن مدة العمل. - اعتماد عطلة نهاية الأسبوع الجمعة والسبت. الدالة بشكلها النهائي: Function WORKDAY_INTL(ByVal StartDate As Date, _ NetDays As Integer, _ Optional ByVal Weekend As Variant, _ Optional ByVal CompatibleWithExcel As Boolean = False) As Date 'WORKDAY.INTL شبيهة بدالة الاكسل Dim DayOfWeek1 As VbDayOfWeek Dim DayOfWeek2 As VbDayOfWeek Dim WkDays1 As Integer Dim WkDays2 As Integer Dim EndDate As Date Dim NetDays2 As Integer Dim DefWeekend As Byte Dim LoopRepeat As Integer '---------------------------------------------------- If CompatibleWithExcel Then StartDate = StartDate + 1 DefWeekend = IIf(CompatibleWithExcel, 1, 7) If IsMissing(Weekend) Then Weekend = DefWeekend If Not IsNumeric(Weekend) Then Weekend = DefWeekend If Weekend < 1 Or Weekend > 17 Then Weekend = DefWeekend If Weekend > 7 And Weekend < 11 Then Weekend = DefWeekend '---------------------------------------------------- If Weekend <= 7 Then DayOfWeek1 = myMod(Weekend + 6, 7, True) DayOfWeek2 = myMod(DayOfWeek1 + 1, 7, True) Else DayOfWeek1 = Weekend - 10 DayOfWeek2 = 0 End If WkDays1 = Int(NetDays / IIf(Weekend <= 7, 2.5, 6)) EndDate = StartDate + NetDays + WkDays1 + WkDays2 - 1 WkDays2 = 0: WkDays1 = CountWkDay(StartDate, EndDate, DayOfWeek1) If Weekend <= 7 Then WkDays2 = CountWkDay(StartDate, EndDate, DayOfWeek2) NetDays2 = EndDate - StartDate - WkDays1 - WkDays2 + 1 Do While NetDays <> NetDays2 LoopRepeat = LoopRepeat + 1: If LoopRepeat >= 10 Then Exit Do NetDays2 = NetDays2 + IIf(NetDays > NetDays2, 1, -1) EndDate = StartDate + NetDays2 + WkDays1 + WkDays2 - 1 WkDays2 = 0: WkDays1 = CountWkDay(StartDate, EndDate, DayOfWeek1) If Weekend <= 7 Then WkDays2 = CountWkDay(StartDate, EndDate, DayOfWeek2) NetDays2 = EndDate - StartDate - WkDays1 - WkDays2 + 1 Loop If Weekday(EndDate) = DayOfWeek1 Or Weekday(EndDate) = DayOfWeek2 Then EndDate = EndDate - 1 If Weekday(EndDate) = DayOfWeek1 Or Weekday(EndDate) = DayOfWeek2 Then EndDate = EndDate - 1 WORKDAY_INTL = EndDate End Function مرفق ملف اكسل يمكنكم عمل اختبارات عليه والرجوع لي في حال وجود أخطاء لتصحيحها. ايام عمل_08.xlsm

هي كذلك تماشيا مع الدالة الأصل في الاكسل، وهذه الملاحظة يمكنكم قراءتها في مشاركاتي السابقة صمن صورة مرفقة وفي أول سطر ضمن عنوان الملاحظات. تاريخ البداية هو ليس أول يوم دوام بل آخر يوم في الفترة السابقة قبل الدوام.

الدالة بعد الترقية: تحت التطوير والتنقيح والفحص من جديد دوال مساندة: Function CountWkDay(ByVal Date1 As Date, _ ByVal Date2 As Date, _ WkDay As VbDayOfWeek) As Long 'Weekend Days Counter Date1 = Date1 - 1 Date1 = Fix((Date1 + (7 - WkDay)) / 7) Date2 = Fix((Date2 + (7 - WkDay)) / 7) CountWkDay = Date2 - Date1 End Function Function myMod(ByVal Number As Double, ByVal Divisor As Double, _ Optional NoZero As Boolean = False) As Double Dim Result As Variant If Divisor <> 0 Then Result = Number - Divisor * Int(Number / Divisor) Else Result = Number End If myMod = IIf(Result = 0 And NoZero, Divisor, Result) End Function من عنده اكسل اصدار حديث فليجرب هذه الدالة ويقارنها مع دالة الاكسل. دالة الاكسل

المعالجة يعني (التحايل) في استخدامها وإلا الاستخدام المعياري الصحيح لها مختلف. يلزم الانتباه.

نعم استاذ موسى، هو التعديل الأخير بهذا الشأن وهي لا تحسبه كيوم عمل بل تحسبه من ضمن إجمالي المدة ولكن يبقى أيام العمل الفعلية صحيحة كالتالي: والتعديل كان بإضافة هذين السطرين: If Weekday(ToDate) >= vbFriday Then ToDate = ToDate - 1 If Weekday(ToDate) >= vbFriday Then ToDate = ToDate - 1 الآن إذا هذه الدالة مطلوبة فعلا للأكسس وليس لها بديل سأقوم بتطويرها لتشبه تماما دالة الاكسل للإصدارات الحديثة بإضافة خيارات آخر الأسبوع واعتماد تاريخ البداية هو اليوم السابق للمدة الجديدة. رأي الجميع مطلوب، وإلا تركناها كما هي. التعديلات سوف تكون لقسم الأكسس دون قسم الاكسل.

تم الانتهاء من الفحص ومرفق الملف الأخير. ايام عمل_07.xlsm

أعتذر المعالجة سليمة واتضحت بعد التعديل على دالتي، والتعديل كان بحذف أيام العطلة الأسبوعية في نهاية المدة. فاستخدام الدالة بهذه الصورة: = WORKDAY(C5,100) - 1 سليما. الدالة بعد التعديل: Function myWorkDay(FmDate As Date, NetDays1 As Integer) As Date 'WORKDAY شبيهة بدالة الاكسل 'FmDate أول يوم عمل Dim Weekends As Integer Dim ToDate As Date Dim NetDays2 As Integer Dim LoopRepeat As Integer Weekends = Int(NetDays1 / 2.5) ToDate = FmDate + NetDays1 + Weekends - 1 Weekends = CountWkDay(FmDate, ToDate, vbFriday) + _ CountWkDay(FmDate, ToDate, vbSaturday) NetDays2 = ToDate - FmDate - Weekends + 1 Do While NetDays1 <> NetDays2 LoopRepeat = LoopRepeat + 1 If LoopRepeat = 10 Then 'Debug.Print "LoopRepeat", LoopRepeat Exit Do End If If NetDays1 > NetDays2 Then NetDays2 = NetDays2 + 1 Else NetDays2 = NetDays2 - 1 End If ToDate = FmDate + NetDays2 + Weekends - 1 Weekends = CountWkDay(FmDate, ToDate, vbFriday) + _ CountWkDay(FmDate, ToDate, vbSaturday) NetDays2 = ToDate - FmDate - Weekends + 1 Loop If Weekday(ToDate) >= vbFriday Then ToDate = ToDate - 1 If Weekday(ToDate) >= vbFriday Then ToDate = ToDate - 1 myWorkDay = ToDate End Function وعليه لا حاجة لمستخدمي الاكسل لدالتي، وتبقى مطلوبة لمستخدمي الأكسس. يبقى فحص دالة واحدة فقط.

تم التعديل على الدالة أعلاه بإضافة سطرين قبل نهاية الدالة.

اضطررت أن أرسل ملفي إلى صديق ليحوله إلى إصدار أعلى لأرى نتائج الدوال الأخرى. يكفي التركيز على أول سجلين، أشبعوها فحصا وتأكدوا من تطبيق المعادلات بشكل صحيح حتى لا نظلم نتائجها. أرجو الاهتمام بالموضوع بشكل علمي وبعيدا عن المجاملات وحساب الخواطر 🙂. وهذه دعوة للجميع وليس لمن شاركوا في هذا الموضوع فقط. ايام عمل_06.xlsm

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

ممتاز، هذه الدالة جلبها الزميل أحمد حليم وهي لا تلبي طلبك لأن هذه الدالة تحسب لك الأيام وليس تاريخ النهاية، فهي تحتاج تاريخين البداية والنهاية ومعرف العطلة الأسبوعية. أما طلبك فهو عملية عكسية لهذه الدالة فيبقى عندك ثلاث فقط من أصل أربع دوال.

حياك الله يا هاوي اكسل سألتك عن الدوال، فالملفات/المرفقات تحتوي على أربع دوال وهي: WORKDAY WORKDAY.INTL NETWORKDAYS.INTL MyWorkDay فأيهم اخترت؟

ياريت توضح لنا أي دالة استخدمت. وإذا كانت الدالة WORKDAY.INTL فهل يمكنك إضافتها لمرفقي (بعد ترفية الملف طبعا) بإضافة عمود جديد للسنة كاملة ثم رفع الملف. أحتاج للمقارنة ضروري.

الإجراء بسيط جدا لا يمكن أن يتسبب ببطء العمل، ربما حجم البيانات كبير والعمليات كبيرة. فتأثيره كتأثير تغيير التاريخ كتابةً. أما سطور "التسريع" كما سميتها لن يكون لها أي أثر مع هذا الأمر البسيط فوجودها كعدمها. إذا يمكنك رفع ملفك فارفعه.

صممت دالة باسم myWorkDay شبيهة بدالة الاكسل WORKDAY لحساب آخر يوم في العمل وتحتاج إلى مدخلين أول يوم في العمل و عدد أيام عمل فعلي بدون العطل الاسبوعية. جربوها فربما تنفعكم. Option Explicit Function myWorkDay(FmDate As Date, NetDays1 As Integer) As Date 'WORKDAY شبيهة بدالة الاكسل 'FmDate أول يوم عمل Dim Weekends As Integer Dim ToDate As Date Dim NetDays2 As Integer Dim LoopRepeat As Integer Weekends = Int(NetDays1 / 2.5) ToDate = FmDate + NetDays1 + Weekends - 1 Weekends = CountWkDay(FmDate, ToDate, vbFriday) + _ CountWkDay(FmDate, ToDate, vbSaturday) NetDays2 = ToDate - FmDate - Weekends + 1 Do While NetDays1 <> NetDays2 LoopRepeat = LoopRepeat + 1 If LoopRepeat = 10 Then 'Debug.Print "Looprepeat", LoopRepeat Exit Do End If If NetDays1 > NetDays2 Then NetDays2 = NetDays2 + 1 Else NetDays2 = NetDays2 - 1 End If ToDate = FmDate + NetDays2 + Weekends - 1 Weekends = CountWkDay(FmDate, ToDate, vbFriday) + _ CountWkDay(FmDate, ToDate, vbSaturday) NetDays2 = ToDate - FmDate - Weekends + 1 Loop If Weekday(ToDate) >= vbFriday Then ToDate = ToDate - 1 If Weekday(ToDate) >= vbFriday Then ToDate = ToDate - 1 myWorkDay = ToDate End Function Function CountWkDay(ByVal Date1 As Date, _ ByVal Date2 As Date, _ WkDay As VbDayOfWeek) As Long 'WeekDay Counter Date1 = Date1 - 1 Date1 = Fix((Date1 + (7 - WkDay)) / 7) Date2 = Fix((Date2 + (7 - WkDay)) / 7) CountWkDay = Date2 - Date1 End Function يوجد مثال اكسل في هذه المشاركة:

معالجة خاطئة، وقد عملت مقارنة لسنة كاملة وأظهرت خطأ المعالجة. يبقى دالتي لمن يستعملون نسخ قديمة من الاكسل أو دالة WORKDAY.INTL للإصدارات الحديثة، لم أجربها لأن نسخة الاكسل عندي قديمة ويمكن كذلك استخدام دالتي. ايام عمل_05.xlsm

جربوا مثالي أيضا ايام عمل_03.xlsm

أبوأحمد سبقني 🙂 كيف استخدم زر الزيادة أو نقصان_02.xlsm

حياك الله أبا خليل، سؤالي كان للسائل، فمن الجيد أن يجرب طالب العلم أكثر من حل ليقف على أفضلها ولتوسع من مداركه وخبرته. أحيانا بعض أسئلتي قد تثير استغراب من يتابعني ويسأل كيف بخبير يسأل عن أمور بسيطة أو يمدح عملا وكأنه يمر عليه لأول مرة. والحقيقة هي بسبب مشكلتين لدي أولهما صحية وهي ضعف الذاكرة وزيادة تشتت الانتباه وثانيهما هو هجري/تركي للأكسس ربما 15 سنة أو أكثر ولم تعد لغتي الأساسية. كثيرا بالصدفة أرى ما يخالف تعليقاتي في برامجي القديمة فأضحك عليها، وأقول في نفسي خليها فمن منهم يعرف "أبو أحمد" على الواقع 🙂.

ويمكن جعل الحدث هكذا أيضا: Private Sub Report_Open(Cancel As Integer) DoCmd.Restore End Sub مع حتى اقتراحي الأول سعمل بشكل جيد ولكن لماذا تخطيته، هل سيسبب مشكلة في التشغيل؟ "سؤال استفاهمي"

وإذا ما أحببت عدم التكبير اجعل حدث عند الفتح للتقرير هكذا: Private Sub Report_Open(Cancel As Integer) DoCmd.Maximize DoCmd.Restore End Sub

حاول أن تجعل خاصية Modal تساوي No للنموذج وتجعل خاصية Pop Up للتقرير Yes وربما هناك حلول أفضل.

حياك الله عزيزي، نفس المشاكل في الأمثلة السابقة 🙂