حساب ايام الجمع والسبت

The best · السبت at 19:55

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

اريد حساب عدد أيام الجمع والسبت من كل شهر كما فى الجدول

تم تعديل السبت at 20:09 بواسطه The best

**Foksh** · السبت at 23:46

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

من خلال تصميمك للجدول ، نستطيع انشاء دالة عامة في مديول كالتالي - بناءً على أسماء الأشهر لديك :-

Function CalculateFridaysSaturdays(monthName As String, year As Integer, Optional dayType As String = "Both") As Variant
    Dim monthNumber As Integer
    Dim startDate As Date
    Dim endDate As Date
    Dim currentDate As Date
    Dim fridays As Integer
    Dim saturdays As Integer
    
    Select Case monthName
        Case "يناير"
            monthNumber = 1
        Case "فبراير"
            monthNumber = 2
        Case "مارس"
            monthNumber = 3
        Case "ابريل"
            monthNumber = 4
        Case "مايو"
            monthNumber = 5
        Case "يونيو"
            monthNumber = 6
        Case "يوليو"
            monthNumber = 7
        Case "اغسطس"
            monthNumber = 8
        Case "سبتمبر"
            monthNumber = 9
        Case "اكتوبر"
            monthNumber = 10
        Case "نوفمبر"
            monthNumber = 11
        Case "ديسمبر"
            monthNumber = 12
        Case Else
            CalculateFridaysSaturdays = "اسم الشهر غير صحيح"
            Exit Function
    End Select
    
    startDate = DateSerial(year, monthNumber, 1)
    endDate = DateSerial(year, monthNumber + 1, 0)
    
    fridays = 0
    saturdays = 0
    currentDate = startDate
    
    Do While currentDate <= endDate
        If Weekday(currentDate) = vbFriday Then
            fridays = fridays + 1
        ElseIf Weekday(currentDate) = vbSaturday Then
            saturdays = saturdays + 1
        End If
        currentDate = currentDate + 1
    Loop
    
    If dayType = "Friday" Then
        CalculateFridaysSaturdays = fridays
    ElseIf dayType = "Saturday" Then
        CalculateFridaysSaturdays = saturdays
    Else
        CalculateFridaysSaturdays = Array(fridays, saturdays)
    End If
End Function

ومن خلال استعلام تحديث ، تستطيع استدعاء الدالة لتحديث القيم في الحقلين حسب السنة الحالية كالآتي :-

UPDATE data_shr SET gm = CalculateFridaysSaturdays([shr], Year(Date()), "Friday"), sbt = CalculateFridaysSaturdays([shr], Year(Date()), "Saturday");

النتيجة ، افتح استعلام التحديث Query2 وشوف النتيجة في المرفق التالي :-

ايام الغياب.accdb

**ابو جودي** · الأحد at 05:22

طيب ممكن مشاركة اثراء للموضوع يا استاذ @Foksh
ايه رايك طالما كده كده هنعمل اكواد داخل موديول نتوسع فى الافكار ونشطح بخيالنا حبتين علشان يكون قفلنا كل المشاكل الممكن حدوثها

شوف يا سيدى انا اقصد بالمشاكل مثلا عندك شهر ابريل ممكن يكون أبريل وشهر يونيه ممكن يكون يونيو
ده على سبيل المثال وليس الحصر

خلينا بقه نستخدم القواميس الممتعه فى شغلها ونكتب الداله من خلالها بالشكل ده

Option Compare Database
Option Explicit

' تهيئة القواميس مرة واحدة فقط لتوفير الأداء
Dim monthsDict As Object
Dim daysDict As Object

' دالة لإنشاء قاموس ديناميكيًا
Public Function CreateDictionary() As Object
    Set CreateDictionary = CreateObject("Scripting.Dictionary")
End Function

' تهيئة القواميس عند بدء التشغيل
Sub InitializeDictionaries()
    If monthsDict Is Nothing Then Set monthsDict = InitializeMonthsDictionary()
    If daysDict Is Nothing Then Set daysDict = InitializeDaysDictionary()
End Sub

Function GetDaysInfo(monthInput As Variant, Optional yearValue As Variant = -1, Optional targetDay As Variant = "MonthDays") As Variant
    Dim MonthNumber As Long
    Dim firstDay As Date
    Dim totalDays As Long
    Dim daysArray(1 To 7) As Long
    Dim currentDate As Date
    Dim result As Variant
    Dim i As Long
    
    ' تهيئة القواميس مرة واحدة
    InitializeDictionaries
    
    '--- تعديل رئيسي: التحقق من السنة ---
    If IsMissing(yearValue) Or yearValue = -1 Then
        yearValue = Year(Date) ' استخدام السنة الحالية إذا لم تُحدد
    Else
        ' التأكد من أن yearValue هو رقم صحيح
        If Not IsNumeric(yearValue) Then
            GetDaysInfo = "خطأ: السنة يجب أن تكون رقمًا"
            Exit Function
        End If
        yearValue = CLng(yearValue)
    End If
    
    ' تعيين السنة الحالية إذا لم تُمرر
    If yearValue = 0 Then yearValue = Year(Date)
    
    ' معالجة إدخال الشهر
    If IsNumeric(monthInput) Then
        MonthNumber = CLng(monthInput)
    Else
        MonthNumber = GetNumberFromDict(monthsDict, monthInput)
    End If
    
    If MonthNumber < 1 Or MonthNumber > 12 Then
        GetDaysInfo = "خطأ في الشهر: " & monthInput & vbCrLf & "الأشهر المتاحة: " & Join(monthsDict.Keys, ", ")
        Exit Function
    End If
    
    ' حساب أيام الشهر
    totalDays = Day(DateSerial(yearValue, MonthNumber + 1, 0))
    firstDay = DateSerial(yearValue, MonthNumber, 1)
    
    ' تهيئة المصفوفة
    For i = 1 To 7
        daysArray(i) = 0
    Next i
    
    ' حساب أيام الأسبوع (الأحد = 1)
    For i = 0 To totalDays - 1
        currentDate = firstDay + i
        daysArray(Weekday(currentDate, vbSunday)) = daysArray(Weekday(currentDate, vbSunday)) + 1
    Next i
    
    ' معالجة طلب اليوم المستهدف
    Select Case True
        Case targetDay = "MonthDays" Or targetDay = "أيام_الشهر"
            result = totalDays
        Case targetDay = "ALL" Or targetDay = "الكل"
            result = daysArray
        Case Else
            Dim dayCode As Long
            dayCode = GetNumberFromDict(daysDict, targetDay)
            If dayCode = 0 Then
                GetDaysInfo = "خطأ في اليوم: " & targetDay & vbCrLf & "الأيام المتاحة: " & Join(daysDict.Keys, ", ")
                Exit Function
            End If
            result = daysArray(dayCode)
    End Select
    
    GetDaysInfo = result
End Function

Function InitializeMonthsDictionary() As Object
    Dim dict As Object
    Set dict = CreateDictionary()
    
    With dict
        ' شهر 1
        .Add "1", 1
        .Add "jan", 1
        .Add "january", 1
        .Add "يناير", 1
        .Add "ينا", 1
        .Add "ين", 1
        
        ' شهر 2
        .Add "2", 2
        .Add "feb", 2
        .Add "february", 2
        .Add "فبراير", 2
        .Add "فبر", 2
        .Add "فب", 2
        
        ' شهر 3
        .Add "3", 3
        .Add "mar", 3
        .Add "march", 3
        .Add "مارس", 3
        .Add "ماس", 3
        .Add "ما", 3
        
        ' شهر 4
        .Add "4", 4
        .Add "apr", 4
        .Add "april", 4
        .Add "أبريل", 4
        .Add "إبريل", 4
        .Add "ابريل", 4
        .Add "ابر", 4
        
        ' شهر 5
        .Add "5", 5
        .Add "may", 5
        .Add "مايو", 5
        .Add "ماي", 5
        
        ' شهر 6
        .Add "6", 6
        .Add "jun", 6
        .Add "june", 6
        .Add "يونية", 6
        .Add "يونيه", 6
        .Add "يونيو", 6
        .Add "يون", 6
        
        ' شهر 7
        .Add "7", 7
        .Add "jul", 7
        .Add "july", 7
        .Add "يوليو", 7
        .Add "يوليه", 7
        .Add "يولية", 7
        .Add "يول", 7
        
        ' شهر 8
        .Add "8", 8
        .Add "aug", 8
        .Add "august", 8
        .Add "أغسطس", 8
        .Add "اغسطس", 8
        .Add "أغس", 8
        
        ' شهر 9
        .Add "9", 9
        .Add "sep", 9
        .Add "september", 9
        .Add "سبتمبر", 9
        .Add "سبت", 9
        
        ' شهر 10
        .Add "10", 10
        .Add "oct", 10
        .Add "october", 10
        .Add "أكتوبر", 10
        .Add "اكتوبر", 10
        .Add "أكت", 10
        
        ' شهر 11
        .Add "11", 11
        .Add "nov", 11
        .Add "november", 11
        .Add "نوفمبر", 11
        .Add "نوف", 11
        
        ' شهر 12
        .Add "12", 12
        .Add "dec", 12
        .Add "december", 12
        .Add "ديسمبر", 12
        .Add "ديس", 12
    End With
    
    Set InitializeMonthsDictionary = dict
End Function

Function InitializeDaysDictionary() As Object
    Dim dict As Object
    Set dict = CreateDictionary()
    
    With dict
        ' الأحد
        .Add "1", 1
        .Add "sun", 1
        .Add "sunday", 1
        .Add "الأحد", 1
        .Add "الاحد", 1
        .Add "أحد", 1
        .Add "احد", 1
        .Add "ح", 1
        
        ' الإثنين
        .Add "2", 2
        .Add "mon", 2
        .Add "monday", 2
        .Add "الإثنين", 2
        .Add "الاثنين", 2
        .Add "إثنين", 2
        .Add "اثنين", 2
        .Add "ن", 2
        
        ' الثلاثاء
        .Add "3", 3
        .Add "tue", 3
        .Add "tuesday", 3
        .Add "الثلاثاء", 3
        .Add "ثلاثاء", 3
        .Add "ث", 3
        
        ' الأربعاء
        .Add "4", 4
        .Add "wed", 4
        .Add "wednesday", 4
        .Add "الأربعاء", 4
        .Add "الاربعاء", 4
        .Add "أربعاء", 4
        .Add "ر", 4
        
        ' الخميس
        .Add "5", 5
        .Add "thu", 5
        .Add "thursday", 5
        .Add "الخميس", 5
        .Add "خميس", 5
        .Add "خ", 5
        
        ' الجمعة
        .Add "6", 6
        .Add "fri", 6
        .Add "friday", 6
        .Add "الجمعة", 6
        .Add "الجمعه", 6
        .Add "جمعة", 6
        .Add "جم", 6
        .Add "ج", 6
        
        ' السبت
        .Add "7", 7
        .Add "sat", 7
        .Add "saturday", 7
        .Add "السبت", 7
        .Add "سبت", 7
        .Add "س", 7
    End With
    
    Set InitializeDaysDictionary = dict
End Function

Function GetNumberFromDict(dict As Object, key As Variant) As Long
    key = LCase(Trim(CStr(key)))
    If dict.Exists(key) Then
        GetNumberFromDict = dict(key)
    Else
        GetNumberFromDict = 0
    End If
End Function

ودى كل نتائج الكود من خلال استعلام

SELECT 
    shr,
    GetDaysInfo([shr], 0, "MonthDays") AS عدد_أيام_الشهر,
    GetDaysInfo([shr], 0, "Sunday") AS عدد_أيام_الأحد,
    GetDaysInfo([shr], 0, "Monday") AS عدد_أيام_الاثنين,
    GetDaysInfo([shr], 0, "Tuesday") AS عدد_أيام_الثلاثاء,
    GetDaysInfo([shr], 0, "Wednesday") AS عدد_أيام_الأربعاء,
    GetDaysInfo([shr], 0, "Thursday") AS عدد_أيام_الخميس,
    GetDaysInfo([shr], 0, "ج") AS عدد_أيام_الجمعة,
    GetDaysInfo([shr], 0, "السبت") AS عدد_أيام_السبت
FROM data_shr;

المميزات فى الكود

دعم كامل للغات: يقبل المدخلات بالعربية والإنجليزية (كاملة ومختصرة)

كفاءة عالية: تهيئة القواميس مرة واحدة فقط

مرونة استثنائية: يقبل حتى الاختصارات غير التقليدية واقصد بذلك
الأشهر: إضافة اختصارات مثل "ينا" (يناير), "فبر" (فبراير), "ابر" (أبريل), "ديس" (ديسمبر)
الأيام: إضافة اختصارات مثل "ح" (الأحد), "ن" (الإثنين), "جم" (الجمعة)

توثيق ذاتي: يعرض جميع الخيارات المتاحة عند حدوث خطأ

شئ مهم كمان:
ثبات النتائج: تم تثبيت بداية الأسبوع على يوم الأحد باستخدام Weekday(currentDate, vbSunday) لتجنب تأثير إعدادات النظام و لحساب الأيام بشكل دقيق

تقدر تجرب من خلال الاستعلام ده شوف فى الاستدعاء الطرق المختلفة لشهر اكتوبر وليوم الاحد والتى تظهر المرونة المطلقة فى الاستدعاء

SELECT 
    shr,
    GetDaysInfo(10,0,"MonthDays") AS عدد_أيام_الشهر,
    GetDaysInfo("اكتوبر", 0, "ح") AS 2عدد_أيام_الأحد,
    GetDaysInfo("اكتوبر", 0, "أحد") AS 3عدد_أيام_الأحد,
    GetDaysInfo("اكتوبر", 0, "sun") AS 4عدد_أيام_الأحد,
    GetDaysInfo(10, 0, 1) AS 5عدد_أيام_الأحد
FROM data_shr;

**Foksh** · الأحد at 06:52

منذ ساعه, ابو جودي said:

طيب ممكن مشاركة اثراء للموضوع يا استاذ @Foksh
ايه رايك طالما كده كده هنعمل اكواد داخل موديول نتوسع فى الافكار ونشطح بخيالنا حبتين علشان يكون قفلنا كل المشاكل الممكن حدوثها

شوف يا سيدى انا اقصد بالمشاكل مثلا عندك شهر ابريل ممكن يكون أبريل وشهر يونيه ممكن يكون يونيو
ده على سبيل المثال وليس الحصر

خلينا بقه نستخدم القواميس الممتعه فى شغلها ونكتب الدالخ من خلالها بالشكل ده

Option Compare Database
Option Explicit

' تهيئة القواميس مرة واحدة فقط لتوفير الأداء
Dim monthsDict As Object
Dim daysDict As Object

' دالة لإنشاء قاموس ديناميكيًا
Public Function CreateDictionary() As Object
    Set CreateDictionary = CreateObject("Scripting.Dictionary")
End Function

' تهيئة القواميس عند بدء التشغيل
Sub InitializeDictionaries()
    If monthsDict Is Nothing Then Set monthsDict = InitializeMonthsDictionary()
    If daysDict Is Nothing Then Set daysDict = InitializeDaysDictionary()
End Sub

Function GetDaysInfo(monthInput As Variant, Optional yearValue As Variant = -1, Optional targetDay As Variant = "MonthDays") As Variant
    Dim MonthNumber As Long
    Dim firstDay As Date
    Dim totalDays As Long
    Dim daysArray(1 To 7) As Long
    Dim currentDate As Date
    Dim result As Variant
    Dim i As Long
    
    ' تهيئة القواميس مرة واحدة
    InitializeDictionaries
    
    '--- تعديل رئيسي: التحقق من السنة ---
    If IsMissing(yearValue) Or yearValue = -1 Then
        yearValue = Year(Date) ' استخدام السنة الحالية إذا لم تُحدد
    Else
        ' التأكد من أن yearValue هو رقم صحيح
        If Not IsNumeric(yearValue) Then
            GetDaysInfo = "خطأ: السنة يجب أن تكون رقمًا"
            Exit Function
        End If
        yearValue = CLng(yearValue)
    End If
    
    ' تعيين السنة الحالية إذا لم تُمرر
    If yearValue = 0 Then yearValue = Year(Date)
    
    ' معالجة إدخال الشهر
    If IsNumeric(monthInput) Then
        MonthNumber = CLng(monthInput)
    Else
        MonthNumber = GetNumberFromDict(monthsDict, monthInput)
    End If
    
    If MonthNumber < 1 Or MonthNumber > 12 Then
        GetDaysInfo = "خطأ في الشهر: " & monthInput & vbCrLf & "الأشهر المتاحة: " & Join(monthsDict.Keys, ", ")
        Exit Function
    End If
    
    ' حساب أيام الشهر
    totalDays = Day(DateSerial(yearValue, MonthNumber + 1, 0))
    firstDay = DateSerial(yearValue, MonthNumber, 1)
    
    ' تهيئة المصفوفة
    For i = 1 To 7
        daysArray(i) = 0
    Next i
    
    ' حساب أيام الأسبوع (الأحد = 1)
    For i = 0 To totalDays - 1
        currentDate = firstDay + i
        daysArray(Weekday(currentDate, vbSunday)) = daysArray(Weekday(currentDate, vbSunday)) + 1
    Next i
    
    ' معالجة طلب اليوم المستهدف
    Select Case True
        Case targetDay = "MonthDays" Or targetDay = "أيام_الشهر"
            result = totalDays
        Case targetDay = "ALL" Or targetDay = "الكل"
            result = daysArray
        Case Else
            Dim dayCode As Long
            dayCode = GetNumberFromDict(daysDict, targetDay)
            If dayCode = 0 Then
                GetDaysInfo = "خطأ في اليوم: " & targetDay & vbCrLf & "الأيام المتاحة: " & Join(daysDict.Keys, ", ")
                Exit Function
            End If
            result = daysArray(dayCode)
    End Select
    
    GetDaysInfo = result
End Function

Function InitializeMonthsDictionary() As Object
    Dim dict As Object
    Set dict = CreateDictionary()
    
    With dict
        ' شهر 1
        .Add "1", 1
        .Add "jan", 1
        .Add "january", 1
        .Add "يناير", 1
        .Add "ينا", 1
        .Add "ين", 1
        
        ' شهر 2
        .Add "2", 2
        .Add "feb", 2
        .Add "february", 2
        .Add "فبراير", 2
        .Add "فبر", 2
        .Add "فب", 2
        
        ' شهر 3
        .Add "3", 3
        .Add "mar", 3
        .Add "march", 3
        .Add "مارس", 3
        .Add "ماس", 3
        .Add "ما", 3
        
        ' شهر 4
        .Add "4", 4
        .Add "apr", 4
        .Add "april", 4
        .Add "أبريل", 4
        .Add "إبريل", 4
        .Add "ابريل", 4
        .Add "ابر", 4
        
        ' شهر 5
        .Add "5", 5
        .Add "may", 5
        .Add "مايو", 5
        .Add "ماي", 5
        
        ' شهر 6
        .Add "6", 6
        .Add "jun", 6
        .Add "june", 6
        .Add "يونية", 6
        .Add "يونيه", 6
        .Add "يونيو", 6
        .Add "يون", 6
        
        ' شهر 7
        .Add "7", 7
        .Add "jul", 7
        .Add "july", 7
        .Add "يوليو", 7
        .Add "يوليه", 7
        .Add "يولية", 7
        .Add "يول", 7
        
        ' شهر 8
        .Add "8", 8
        .Add "aug", 8
        .Add "august", 8
        .Add "أغسطس", 8
        .Add "اغسطس", 8
        .Add "أغس", 8
        
        ' شهر 9
        .Add "9", 9
        .Add "sep", 9
        .Add "september", 9
        .Add "سبتمبر", 9
        .Add "سبت", 9
        
        ' شهر 10
        .Add "10", 10
        .Add "oct", 10
        .Add "october", 10
        .Add "أكتوبر", 10
        .Add "اكتوبر", 10
        .Add "أكت", 10
        
        ' شهر 11
        .Add "11", 11
        .Add "nov", 11
        .Add "november", 11
        .Add "نوفمبر", 11
        .Add "نوف", 11
        
        ' شهر 12
        .Add "12", 12
        .Add "dec", 12
        .Add "december", 12
        .Add "ديسمبر", 12
        .Add "ديس", 12
    End With
    
    Set InitializeMonthsDictionary = dict
End Function

Function InitializeDaysDictionary() As Object
    Dim dict As Object
    Set dict = CreateDictionary()
    
    With dict
        ' الأحد
        .Add "1", 1
        .Add "sun", 1
        .Add "sunday", 1
        .Add "الأحد", 1
        .Add "الاحد", 1
        .Add "أحد", 1
        .Add "احد", 1
        .Add "ح", 1
        
        ' الإثنين
        .Add "2", 2
        .Add "mon", 2
        .Add "monday", 2
        .Add "الإثنين", 2
        .Add "الاثنين", 2
        .Add "إثنين", 2
        .Add "اثنين", 2
        .Add "ن", 2
        
        ' الثلاثاء
        .Add "3", 3
        .Add "tue", 3
        .Add "tuesday", 3
        .Add "الثلاثاء", 3
        .Add "ثلاثاء", 3
        .Add "ث", 3
        
        ' الأربعاء
        .Add "4", 4
        .Add "wed", 4
        .Add "wednesday", 4
        .Add "الأربعاء", 4
        .Add "الاربعاء", 4
        .Add "أربعاء", 4
        .Add "ر", 4
        
        ' الخميس
        .Add "5", 5
        .Add "thu", 5
        .Add "thursday", 5
        .Add "الخميس", 5
        .Add "خميس", 5
        .Add "خ", 5
        
        ' الجمعة
        .Add "6", 6
        .Add "fri", 6
        .Add "friday", 6
        .Add "الجمعة", 6
        .Add "الجمعه", 6
        .Add "جمعة", 6
        .Add "جم", 6
        .Add "ج", 6
        
        ' السبت
        .Add "7", 7
        .Add "sat", 7
        .Add "saturday", 7
        .Add "السبت", 7
        .Add "سبت", 7
        .Add "س", 7
    End With
    
    Set InitializeDaysDictionary = dict
End Function

Function GetNumberFromDict(dict As Object, key As Variant) As Long
    key = LCase(Trim(CStr(key)))
    If dict.Exists(key) Then
        GetNumberFromDict = dict(key)
    Else
        GetNumberFromDict = 0
    End If
End Function

ودى كل نتائج الكود من خلال استعلام

SELECT 
    shr,
    GetDaysInfo([shr], 0, "MonthDays") AS عدد_أيام_الشهر,
    GetDaysInfo([shr], 0, "Sunday") AS عدد_أيام_الأحد,
    GetDaysInfo([shr], 0, "Monday") AS عدد_أيام_الاثنين,
    GetDaysInfo([shr], 0, "Tuesday") AS عدد_أيام_الثلاثاء,
    GetDaysInfo([shr], 0, "Wednesday") AS عدد_أيام_الأربعاء,
    GetDaysInfo([shr], 0, "Thursday") AS عدد_أيام_الخميس,
    GetDaysInfo([shr], 0, "ج") AS عدد_أيام_الجمعة,
    GetDaysInfo([shr], 0, "السبت") AS عدد_أيام_السبت
FROM data_shr;

المميزات فى الكود

دعم كامل للغات: يقبل المدخلات بالعربية والإنجليزية (كاملة ومختصرة)

كفاءة عالية: تهيئة القواميس مرة واحدة فقط

مرونة استثنائية: يقبل حتى الاختصارات غير التقليدية واقصد بذلك
الأشهر: إضافة اختصارات مثل "ينا" (يناير), "فبر" (فبراير), "ابر" (أبريل), "ديس" (ديسمبر)
الأيام: إضافة اختصارات مثل "ح" (الأحد), "ن" (الإثنين), "جم" (الجمعة)

توثيق ذاتي: يعرض جميع الخيارات المتاحة عند حدوث خطأ

شئ مهم كمان:
ثبات النتائج: تم تثبيت بداية الأسبوع على يوم الأحد باستخدام Weekday(currentDate, vbSunday) لتجنب تأثير إعدادات النظام و لحساب الأيام بشكل دقيق

تقدر تجرب من خلال الاستعلام ده شوف فى الاستدعاء الطرق المختلفة لشهر اكتوبر وليوم الاحد والتى تظهر المرونة المطلقة فى الاستدعاء

SELECT 
    shr,
    GetDaysInfo(10,0,"MonthDays") AS عدد_أيام_الشهر,
    GetDaysInfo("اكتوبر", 0, "ح") AS 2عدد_أيام_الأحد,
    GetDaysInfo("اكتوبر", 0, "أحد") AS 3عدد_أيام_الأحد,
    GetDaysInfo("اكتوبر", 0, "sun") AS 4عدد_أيام_الأحد,
    GetDaysInfo(10, 0, 1) AS 5عدد_أيام_الأحد
FROM data_shr;

يا اهلاً ومرحباً بصاحب الأفكار الجميلة ،،

عمل جميل جداً ، ولكن انت تعرفني انني أتجنب التوسعات التي قد تُربك صاحب الطلب في إجاباتي 😉 .

**ابو جودي** · الأحد at 09:39

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

ولكن انت تعرفني انني أتجنب التوسعات التي قد تُربك صاحب الطلب في إجاباتي 😉 .

انا لم اقدم توسعات
صاحب الطلب يعتمد على براميتر باللغة العربية
وكما اوضحت لك

ممكن شهر 7 بالعربى يتم استخدامه بالاشكال الاتيه
يوليو - يوليه - يولية

وبتثبيت الكود على احدهم سيتوقف الكود مع الباقى

وهكذا مع الايام فى موضوع الهمزات والتاء والهاء المربوطتان

التوسعه الوحيده التى قمت بها اضافة اختصارات للقاموس لسهولة الاستدعاء او لدعم تعدد الاستدعاء

والباقى كله مرونه لتعمل الدوال عند الاستدعاء مع الاسماء او الارقام للشهور والايام لا اكثر من ذلك ولا اقل

وفى النهايه هى معلومات قمت بتقديمها اثراء للموضوع يا عسل ولتكون مرجعا لمن يريد فى المستقبل

The best · الأحد at 14:47

15 ساعات مضت, Foksh said:

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

من خلال تصميمك للجدول ، نستطيع انشاء دالة عامة في مديول كالتالي - بناءً على أسماء الأشهر لديك :-

Function CalculateFridaysSaturdays(monthName As String, year As Integer, Optional dayType As String = "Both") As Variant
    Dim monthNumber As Integer
    Dim startDate As Date
    Dim endDate As Date
    Dim currentDate As Date
    Dim fridays As Integer
    Dim saturdays As Integer
    
    Select Case monthName
        Case "يناير"
            monthNumber = 1
        Case "فبراير"
            monthNumber = 2
        Case "مارس"
            monthNumber = 3
        Case "ابريل"
            monthNumber = 4
        Case "مايو"
            monthNumber = 5
        Case "يونيو"
            monthNumber = 6
        Case "يوليو"
            monthNumber = 7
        Case "اغسطس"
            monthNumber = 8
        Case "سبتمبر"
            monthNumber = 9
        Case "اكتوبر"
            monthNumber = 10
        Case "نوفمبر"
            monthNumber = 11
        Case "ديسمبر"
            monthNumber = 12
        Case Else
            CalculateFridaysSaturdays = "اسم الشهر غير صحيح"
            Exit Function
    End Select
    
    startDate = DateSerial(year, monthNumber, 1)
    endDate = DateSerial(year, monthNumber + 1, 0)
    
    fridays = 0
    saturdays = 0
    currentDate = startDate
    
    Do While currentDate <= endDate
        If Weekday(currentDate) = vbFriday Then
            fridays = fridays + 1
        ElseIf Weekday(currentDate) = vbSaturday Then
            saturdays = saturdays + 1
        End If
        currentDate = currentDate + 1
    Loop
    
    If dayType = "Friday" Then
        CalculateFridaysSaturdays = fridays
    ElseIf dayType = "Saturday" Then
        CalculateFridaysSaturdays = saturdays
    Else
        CalculateFridaysSaturdays = Array(fridays, saturdays)
    End If
End Function

ومن خلال استعلام تحديث ، تستطيع استدعاء الدالة لتحديث القيم في الحقلين حسب السنة الحالية كالآتي :-

UPDATE data_shr SET gm = CalculateFridaysSaturdays([shr], Year(Date()), "Friday"), sbt = CalculateFridaysSaturdays([shr], Year(Date()), "Saturday");

النتيجة ، افتح استعلام التحديث Query2 وشوف النتيجة في المرفق التالي :-

ايام الغياب.accdb 404 kB · 9 downloads

جهد مشكور

لكن السنة اللى بشتغل عليها بتكون بهذه الطريقة 2025/2024 .

هل ممكن اضافة حقل للسنة يتحدث بناء عليها . وشكرا مقدما

حاجة تانى لما اضغط على زر تحديث من النموذج تظهر هذه الرسالة

Compile error

Sub or function not defined

تم تعديل الأحد at 15:19 بواسطه The best

**ابو جودي** · الأحد at 16:00

منذ ساعه, The best said:

لكن السنة اللى بشتغل عليها بتكون بهذه الطريقة 2025/2024 .

يعنى انت تقصد ايه ان السنه بالطريقة دى

تقصد العمل لعام 2024 ولعام 2025 معا
يعنى مثلا النتيجه لـ
("فبراير", "2024/2025", "أيام_الشهر")
المفروض تكون ايه

انت طلبك مش واضح

**Foksh** · الأحد at 16:30

1 ساعه مضت, The best said:

جهد مشكور

لكن السنة اللى بشتغل عليها بتكون بهذه الطريقة 2025/2024 .

هل ممكن اضافة حقل للسنة يتحدث بناء عليها . وشكرا مقدما

حاجة تانى لما اضغط على زر تحديث من النموذج تظهر هذه الرسالة

Compile error

Sub or function not defined

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

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

The best · الأحد at 17:07

37 دقائق مضت, Foksh said:

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

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

حضرتك المطلوب شهور اكتوبر ونوفمبر وديسمبر 2024 ، ومن يناير الى يونيو 2025 وهكذا

يعنى هيكون الحساب لشهور اكتوبر ونوفمبر وديسمبر من عام ومن يناير الى يونيو من عام ثانى

واضفت جدول للقاعدة فيه حقل العام الدراسى

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

وتقبل اعتذراى كنت لم أنوه عن ذلك فى البداية

ايام الغياب.accdb

تم تعديل الأحد at 17:09 بواسطه The best

**Foksh** · الأحد at 17:37

1 ساعه مضت, The best said:

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

اعتذر عن عدم حذف النموذج ، فهو كان للتجربة فقط لا غير ، ولم آت على ذكره في حلي معتقداً اني حذفته . وكان الحل مقتصراً في ردي على فتح الاستعلام Query2 فقط !!

اقتباس

حضرتك المطلوب شهور اكتوبر ونوفمبر وديسمبر 2024 ، ومن يناير الى يونيو 2025 وهكذا

اعتقد ان الفكرة تدور حول بداية العام الدراسي مثلاً من شهر 10 من العام الحالي الى شهر 6 من العام التالي صحيح ؟؟

على العموم، قد اتضحت الصورة الآن ، دعني أرى ما يمكنني تعديله :smile: .

تم تعديل الأحد at 18:52 بواسطه Foksh

**Foksh** · الأحد at 18:12

منذ ساعه, The best said:

حضرتك المطلوب شهور اكتوبر ونوفمبر وديسمبر 2024 ، ومن يناير الى يونيو 2025 وهكذا

تم تعديل اسلوب الدالة من المديول على النحو التالي :-

Function CalculateFridaysSaturdays(monthName As String, Optional baseYear As Integer = 0, Optional dayType As String = "Both") As Variant
    Dim monthNumber As Integer
    Dim startDate As Date, endDate As Date
    Dim fridays As Integer, saturdays As Integer
    Dim targetYear As Integer

    monthName = Trim(monthName)

    Select Case monthName
        Case "يناير": monthNumber = 1
        Case "فبراير": monthNumber = 2
        Case "مارس": monthNumber = 3
        Case "ابريل": monthNumber = 4
        Case "مايو": monthNumber = 5
        Case "يونيو": monthNumber = 6
        Case "يوليو": monthNumber = 7
        Case "اغسطس": monthNumber = 8
        Case "سبتمبر": monthNumber = 9
        Case "اكتوبر": monthNumber = 10
        Case "نوفمبر": monthNumber = 11
        Case "ديسمبر": monthNumber = 12
        Case Else
            CalculateFridaysSaturdays = "اسم الشهر غير صحيح"
            Exit Function
    End Select

    If monthNumber >= 10 Then
        targetYear = year(Date) - 1
    ElseIf monthNumber <= 6 Then
        targetYear = year(Date)
    Else
        targetYear = baseYear
    End If

    If targetYear < 1900 Or targetYear > 2100 Then
        CalculateFridaysSaturdays = "السنة غير صحيحة"
        Exit Function
    End If

    fridays = CountWeekdayOccurrences(targetYear, monthNumber, vbFriday)
    saturdays = CountWeekdayOccurrences(targetYear, monthNumber, vbSaturday)

    Select Case LCase(dayType)
        Case "friday": CalculateFridaysSaturdays = fridays
        Case "saturday": CalculateFridaysSaturdays = saturdays
        Case Else: CalculateFridaysSaturdays = Array(fridays, saturdays)
    End Select
End Function

Function CountWeekdayOccurrences(targetYear As Integer, monthNumber As Integer, targetWeekday As Integer) As Integer
    Dim startDate As Date, endDate As Date
    Dim firstDay As Integer, totalDays As Integer
    Dim count As Integer

    startDate = DateSerial(targetYear, monthNumber, 1)
    endDate = DateSerial(targetYear, monthNumber + 1, 0)
    firstDay = Weekday(startDate)
    totalDays = endDate - startDate + 1

    count = ((totalDays + firstDay - targetWeekday) \ 7) + IIf((firstDay <= targetWeekday), 1, 0)

    CountWeekdayOccurrences = count
End Function

✅ تحسين قراءة أسماء الأشهر بحيث لا تتأثر بالمسافات الزائدة .
✅ إضافة فحص للسنة لمنع القيم غير المنطقية .
✅ تحسين الأداء باستخدام دالة تقوم بالحساب المباشر .
✅ تجنب الأخطاء عند تمرير قيم غير صحيحة أو عند التعامل مع أسماء الأشهر .
✅ تحديث الاستعلام SQL بحيث يستبعد القيم غير الصالحة (NULL أو الفراغ) .

👌 النتيجة : كود أسرع وأكثر كفاءة ويعمل دون أخطاء غير متوقعة

بهذه الطريقة ، لن تحتاج إلى تغيير الكود يدوياً كل سنة ، وسيتم احتساب القيم المطلوبة تلقائياً !!

أما الإستعلام ، فقد تم تعديله لمحاكاة الكود السابق على النحو التالي :-

UPDATE data_shr SET gm = CalculateFridaysSaturdays([shr], 0, "Friday"), sbt = CalculateFridaysSaturdays([shr], 0, "Saturday")
WHERE shr IN ("يناير", "فبراير", "مارس", "ابريل", "مايو", "يونيو", "اكتوبر", "نوفمبر", "ديسمبر")
AND shr IS NOT NULL AND shr <> "";

ايام الغياب 2.accdb

* تم حذف الأجزاء السابقة الغير ضرورية لتلافي ظهور رسائل الأخطاء .

تم تعديل الأحد at 18:29 بواسطه Foksh
تعديل المرفق بفكرة أفضل ..

**AbuuAhmed** · الإثنين at 22:31

موضوع قديم ذو صلة:

تسجيل الدخول

حساب ايام الجمع والسبت

الردود الموصى بها

The best

Foksh

ابو جودي

Foksh

ابو جودي

The best

ابو جودي

Foksh

The best

Foksh

Foksh

AbuuAhmed

Join the conversation

تصفح هذا الموضوع مؤخراً 0 اعضاء متواجدين الان

تصفح الموقع

تصفح جديد الموقع

Support

Important Information