AbuuAhmed

في 28‏/8‏/2023 at 00:26, أبوأحـمـد said:

الملف مفتوح

شكرا لكم، هل يمكن رفع نسخة على الإصدار 2007؟

ويمكن اختصار الكود ليصبح كالتالي:

Me.NOTE.Enabled = Me.الرمز = "A"
Me.TIME_WORK.Enabled = Me.الرمز = "A"

أو كالتالي:

Me.NOTE.Locked = Me.الرمز <> "A"
Me.TIME_WORK.Locked = Me.الرمز <> "A"

جرب أدخل الأرقام بالإنجليزي (أرقام عربية وليست هندية) ربما يقبل منك.

9 ساعات مضت, محمد حسن المحمد said:

أسعدني مروركم العطر أخي الكريم

لي الشرف أخي الكريم.

لا أدري هل حلي مكرر أم لا

تحديد يوم وتاريخ بداية كل أسبوع ونهايته حسب التاريخ الحالي_03.xlsx

ذاكرتي اللعينة تجعلني أرتكب الأخطاء
مشاركتي هنا كانت بالخطأ.

حسب فهمي لطلبك إذا كان صحيحا:

Database11_04.accdb

وهناك أضفت لك الطريقة الثانية

Database11_03.accdb

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

Database11_02.accdb

خذ لك نظرة على هذا الموضوع:

يوجد ملف لأم القرى باسم:
EventsCalendar_20070118.rar

تم رفع الملف هنا لتمام الاستفادة

EventsCalendar_20070118.xlsm

حياك الله عزيزي

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

وعليكم السلام ورحمة الله وبركاته
محاولتي

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

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

18 دقائق مضت, Moosak said:

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

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

الدالة بعد الترقية:
 

تحت التطوير والتنقيح والفحص من جديد

دوال مساندة:
 

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

من عنده اكسل اصدار حديث فليجرب هذه الدالة ويقارنها مع دالة الاكسل.

دالة الاكسل
 

10 ساعات مضت, AbuuAhmed said:

أعتذر المعالجة سليمة

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

2 ساعات مضت, Moosak said:

جربتها قبل التعديل .. فوجدتها تحسب يوم الجمعة كيوم عمل .. هل لها ضبط آخر لتحديد أيام العمل من الأحد إلى الخميس ؟

نعم استاذ موسى، هو التعديل الأخير بهذا الشأن وهي لا تحسبه كيوم عمل بل تحسبه من ضمن إجمالي المدة ولكن يبقى أيام العمل الفعلية صحيحة كالتالي:

والتعديل كان بإضافة هذين السطرين:

    If Weekday(ToDate) >= vbFriday Then ToDate = ToDate - 1
    If Weekday(ToDate) >= vbFriday Then ToDate = ToDate - 1

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

التعديلات سوف تكون لقسم الأكسس دون قسم الاكسل.

 

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

ايام عمل_07.xlsm

11 ساعات مضت, AbuuAhmed said:

معالجة خاطئة، وقد عملت مقارنة لسنة كاملة وأظهرت خطأ المعالجة.

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

= 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

1 ساعه مضت, أحمد حليم said:

هل قمت بتجربتها واعطت نتائج خاطئة 

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

12 دقائق مضت, هاوي اكسل said:

NETWORKDAYS.INTL

اخترت هذه

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

3 دقائق مضت, هاوي اكسل said:

جميع الملفات صحيحة

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