Foksh

منذ 1 ساعه

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

الأصل أن تقوم بالشرح لما تريده أخي الفاضل . وبما ان العنوان "استراد وتصدير ملف الاكسيل" ، فلم ترفق ملف اكسل حتى :blink: .

منذ 22 ساعات

منذ ساعه, basem1978 said:

اولا شكرا جزيلا على سرعة الرد

كما أشار بالتعديل الأستاذ خليفة ، استبدل الاستعلام التالي بالاستعلام الذي هو مصدر التقرير :-

SELECT 
    [استعلام اساسي التكليف].[رقم الموظف],
    [استعلام اساسي التكليف].[اسم الموظف],
    [استعلام اساسي التكليف].[رقم القسم],
    [استعلام اساسي التكليف].[اسم القسم],
    [استعلام اساسي التكليف].[رقم الموظف - التكليف],
    [استعلام اساسي التكليف].[تاريخ تسجيل التكليف],
    [استعلام اساسي التكليف].[مدة التكليف],
    [استعلام اساسي التكليف].[تاريخ التكليف],
    [استعلام اساسي التكليف].[ملاحظات التكليف],
    [استعلام اساسي التكليف].[رقم نوع التكيف],
    [استعلام اساسي التكليف].[التكليف - رقم نوع التكليف],
    [استعلام اساسي التكليف].[نوع التكليف],
    [استعلام اساسي التكليف].[المسمى الوظيفي],
    [استعلام اساسي التكليف].[اسم يوم التكليف],
    [استعلام اساسي التكليف].[اسم شهر التكليف],
    [استعلام اساسي التكليف].[الى تاريخ],
    [استعلام اساسي التكليف].[رقم صلاحية التشغيل],
    [استعلام اساسي التكليف].[نوع صلاحية التشغيل],
    [استعلام اساسي التكليف].[رقم شهر التكليف],
    [استعلام اساسي التكليف].[المسئول المباشر],
    [استعلام اساسي التكليف].[اسم المسئول],
    [استعلام اساسي التكليف].[سنة التكليف]
FROM [استعلام اساسي التكليف]
WHERE [استعلام اساسي التكليف].[رقم شهر التكليف] = [ادخل رقم شهر التكليف]
  AND [استعلام اساسي التكليف].[رقم الموظف] IN (
        SELECT [رقم الموظف]
        FROM [استعلام اساسي التكليف]
        WHERE [رقم شهر التكليف] = [ادخل رقم شهر التكليف]
        GROUP BY [رقم الموظف]
        HAVING Count(*) > 10
  )
ORDER BY [استعلام اساسي التكليف].[تاريخ التكليف];

بالامس في 17:42

27 دقائق مضت, basem1978 said:

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

وعليكم السلام ورحمة الله وبركاته .. لم يكن شرحك دقيقاً للطلوب ، ولكن كتجربة ، تابع نتيجة الإيستعلام التالي إن كانت هي المطلوبة أم لا ..

SELECT التكليف.[رقم الموظف - التكليف] AS رقم_الموظف, التكليف.[تاريخ التكليف]
FROM التكليف
WHERE (((التكليف.[رقم الموظف - التكليف]) In (SELECT التكليف.[رقم الموظف - التكليف]
    FROM التكليف
    WHERE Month([تاريخ التكليف]) = [ادخل رقم الشهر]
    GROUP BY التكليف.[رقم الموظف - التكليف]
    HAVING Count(*) > 10
)) AND ((Month([تاريخ التكليف]))=[ادخل رقم الشهر]))
ORDER BY التكليف.[رقم الموظف - التكليف];

* ملاحظاتي ..

إن أردت النجاح في عملك ، ابتعد عن التسميات العربية لعناصر ومكونات مشروعك .

الخميس at 18:31

هل تقصد كهذه الفكرة ؟؟

لاحظ شريط التحرير والتنسيق في الصورة !!

image.gif.ccda8b4d6112d221d4d2fed655b9bd23.gif

الخميس at 10:32

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

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

الخميس at 02:49

أخي الفاضل @بلانك ، استخدم كلمات الإستعجال مثل "للرفع" أو "UP" ، مع الأخذ بعين الإعتبار إن من لديه مشاركة حل ، لن يبخل عليك بأي رد ، ولكن للظروف أحكام 😇 .

الثلاثاء at 22:45

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

قد يفيدك هذا الموضوع بشكل كبير :-

الثلاثاء at 22:37

في 12‏/1‏/2026 at 11:54, ابراهيم170 said:

شاكر ومقدر استاذ حجازي

هذا هو المطلوب بالضبط

نرجو منكم إغلاق الموضوع باختياركم "إختر تمت الإجابة" لإجابة الأستاذ @hegazee بما أنها قد حققت مطلبك بنجاح.

💐 وشكراً لمتابعتكم.

الإثنين at 23:12

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

تقبل الله

منا ومنكم صالح الأعمال والطاعات 💐

يناير 12

في 9‏/1‏/2026 at 15:10, kanory said:

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

أهلاً بك أخي الحبيب @kanory ، سيتم إن شاء الله إضافة العديد من الميزات الى الفكرة قريباً.

21 دقائق مضت, jjafferr said:

اخي فادي

جميل عندما يستفيد الآخرين من عمل معين ، ويضاف عليه لمسات جميلة 🙂

شكرا لك.

معلمنا الحبيب واستاذي وأخي جعفر ..

سيتم طرح العمل بإذن الله تعالى قريباً في موضوع جديد بالإشارة الى هذا الموضوع ، ولكني انشغلت في سفري لأداء العُمرة الأولى لي في حياتي 😇 .

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

يناير 3

3 ساعات مضت, ابوخليل said:

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

أبدعت .. توظيف جميل واستغلال رائع للنموذج الفرعي بدلاً من الرسالة المزعجة فعلاً ..

يناير 1

ما رأيك بهذه الفكرة :-

LBLChangerRightClick.gif.03a7b17c80ba66e97fcbd4e71f77369a.gif

الملف مفتوح المصدر ..

LblChanger - 1.zip

يناير 1

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

جرب هذا التعديل الذي تم على الجمل الشرطية داخل الاستعلام عند التوزيع ..

لجان الامتحانات.zip

ديسمبر 27, 2025

بدايةً ما خطر ببالي كفكرة تتلخص في جدول واحد مخصص للتنفيذ ، ويحتوي الحقول التالية فرضاً ..

حقل لاسم النموذج = نصي
حقل لاسم الزر البرمجي = نصي
حقل للتسمية القديمة = نصي
حقل للتسمية الجديدة = نصي أيضاً
حقل للتنفيذ = نعم / لا

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

يعني بشكل مبسط .زر في كل نموذج مخصص لفتح نموذج ضبط التسميات ( إن صح التعبير ) . وهذا النموذج سيعرض التسميات القديمة والجديدة لكل زر في النموذج الحالي . انظر الصورة كفكرة توضيحية بعد تطبيقها . حيث لدي نموذجين Form1 & Form2 ، بهما العديد من الأزرار للتطبيق والتغذية البصرية . ويوجد زر ايقونته = الإعدادات ، لاحظ انه عند النقر على هذا الزر ماذا حصل !!

سيتم تحميل جميع تسميات الأزرار في النموذج الحالي بدلاً من الاسم البرمجي للزر . لأن المستخدم العادي لن يميز اسمه البرمجي . فكان التوجه إلى إظهار التسميات للأزرار هو الأنسب .

الآن وبعد السيطرة على الأزرار وتحديدها ، انظر للتجربة التالية بعد تغيير اسم مجموعة أزرار ..

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

اعتقد أن الموقع والمنتدى قيد التحديث والتطوير ..

ديسمبر 27, 2025

منذ ساعه, ابوخليل said:

هل من طرق اخرى افضل .. واكثر احترافية ؟

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

ديسمبر 27, 2025

منذ ساعه, ابوخليل said:

اكتب في مربع النص ثم انقر مزدوجا على الزر

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

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

هل توافقني الرأي ؟؟

ديسمبر 25, 2025

بناءً على طلب أخي يوسف ، تم تحويل الكود إلى وحدة نمطية عامة ، بحيث يتم الاستدعاء من أي مكان وأي نموذج . بحيث تصبح :-

Public Function GenerateSalary(yearInput As Integer)

    Dim db As DAO.Database
    Dim tDef As DAO.TableDef
    Dim fld As DAO.Field
    Dim rs As DAO.Recordset
    Dim startDate As Date, endDate As Date, d As Date
    Dim monthName As String
    Dim monthCode As Integer
    Dim shiftValue As Double
    Dim startDateTime As Date
    Dim endDateTime As Date
    Dim monthEndDate As Date
    Dim monthEndWorkDate As Date
    Dim m As Integer, y As Integer

    startDate = DateSerial(yearInput - 1, 12, 21)
    endDate = DateSerial(yearInput, 12, 20)

    On Error Resume Next
    DoCmd.DeleteObject acTable, "Salary"
    On Error GoTo 0

    Set db = CurrentDb
    db.Execute "CREATE TABLE Salary (" & _
           "ID AUTOINCREMENT PRIMARY KEY, " & _
           "WorkDate DATE, " & _
           "DayName TEXT(20), " & _
           "MonthName TEXT(20), " & _
           "monthCode LONG, " & _
           "shift CURRENCY, " & _
           "startDay DATE, " & _
           "endDay DATE)"

    Set tDef = db.TableDefs("Salary")

    Set fld = tDef.Fields("shift")
    On Error Resume Next
    fld.Properties("Format") = "#,##0.00"
    If Err.Number <> 0 Then
        Err.Clear
        fld.Properties.Append fld.CreateProperty("Format", dbText, "#,##0.00")
    End If
    fld.Properties("DecimalPlaces") = 2
    If Err.Number <> 0 Then
        Err.Clear
        fld.Properties.Append fld.CreateProperty("DecimalPlaces", dbInteger, 2)
    End If

    Set fld = tDef.Fields("startDay")
    On Error Resume Next
    fld.Properties("Format") = "hh:nn AM/PM"
    If Err.Number <> 0 Then
        Err.Clear
        fld.Properties.Append fld.CreateProperty("Format", dbText, "hh:nn AM/PM")
    End If

    Set fld = tDef.Fields("endDay")
    On Error Resume Next
    fld.Properties("Format") = "hh:nn AM/PM"
    If Err.Number <> 0 Then
        Err.Clear
        fld.Properties.Append fld.CreateProperty("Format", dbText, "hh:nn AM/PM")
    End If
    On Error GoTo 0

    Set fld = Nothing
    Set tDef = Nothing

    Set rs = db.OpenRecordset("Salary", dbOpenDynaset)

    monthCode = 0
    monthEndWorkDate = DateSerial(yearInput - 1, 12, 20)

    d = startDate
    Do While d <= endDate
        If Weekday(d, vbMonday) <> 5 And Weekday(d, vbMonday) <> 7 Then
            m = Month(d)
            y = Year(d)
            If Day(d) >= 21 Then
                m = m + 1
                If m = 13 Then
                    m = 1
                    y = y + 1
                End If
            End If
            monthName = Format(DateSerial(y, m, 1), "MMMM")

            monthCode = 0
            monthEndDate = DateSerial(Year(d), Month(d), 20)

            If Weekday(monthEndDate, vbMonday) = 5 Or Weekday(monthEndDate, vbMonday) = 7 Then
                monthEndWorkDate = monthEndDate
                Do
                    monthEndWorkDate = DateAdd("d", -1, monthEndWorkDate)
                Loop Until Weekday(monthEndWorkDate, vbMonday) <> 5 And Weekday(monthEndWorkDate, vbMonday) <> 7
            Else
                monthEndWorkDate = monthEndDate
            End If

            If d = monthEndWorkDate Then
                Select Case Month(d)
                    Case 12: If Year(d) = yearInput - 1 Then monthCode = 1 Else monthCode = 12
                    Case 1: monthCode = 1
                    Case 2: monthCode = 2
                    Case 3: monthCode = 3
                    Case 4: monthCode = 4
                    Case 5: monthCode = 5
                    Case 6: monthCode = 6
                    Case 7: monthCode = 7
                    Case 8: monthCode = 8
                    Case 9: monthCode = 9
                    Case 10: monthCode = 10
                    Case 11: monthCode = 11
                End Select
            End If

            If Weekday(d, vbMonday) = 6 Or Weekday(d, vbMonday) = 3 Then
                shiftValue = 1
                startDateTime = DateAdd("n", 30, DateSerial(Year(d), Month(d), Day(d)) + TimeSerial(8, 0, 0))
                endDateTime = DateSerial(Year(d), Month(d), Day(d)) + TimeSerial(13, 30, 0)
            Else
                shiftValue = 1.2
                startDateTime = DateAdd("n", 10, DateSerial(Year(d), Month(d), Day(d)) + TimeSerial(8, 0, 0))
                endDateTime = DateSerial(Year(d), Month(d), Day(d)) + TimeSerial(14, 30, 0)
            End If

            rs.AddNew
            rs!WorkDate = d
            rs!DayName = Format(d, "dddd")
            rs!monthName = monthName
            If monthCode > 0 Then
                rs!monthCode = monthCode
            Else
                rs!monthCode = Null
            End If
            rs!shift = shiftValue
            rs!startDay = startDateTime
            rs!endDay = endDateTime
            rs.Update
        End If
        d = d + 1
    Loop

    rs.Close
    Set rs = Nothing
    db.TableDefs.Refresh
    Set db = Nothing

    MsgBox "تم إنشاء الجدول بنجاح", vbInformation + vbMsgBoxRight, ""
    DoCmd.SelectObject acTable, "Salary", True

End Function

طبعاً تم دمج الدالتين معاً . والإستغناء عن الإستدعاء المتكرر للجملة ElseIf باستخدام الدالة Select Case . وسيصبح الإستدعاء كمثال بالشكل التالي :-

Private Sub btnGenerate_Click()
    If IsNull(Me.TxtYear) Then
        MsgBox "أدخل رقم السنة", vbExclamation + vbMsgBoxRight, ""
        Me.TxtYear.SetFocus
        Exit Sub
    End If
    GenerateSalary (Me.TxtYear)
End Sub

الملف بعد التعديل :-

CalGen2.zip

ديسمبر 24, 2025

😮

أين وجدت الحل ؟؟؟؟؟

ديسمبر 23, 2025

الموضوع الحالي تم فتح النقاش فيه داخل الموضوع التالي :-

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

مغلق للتكرار في موضوع آخر غير منتهي .

ديسمبر 23, 2025

في 23‏/12‏/2025 at 10:50, jo_2010 said:

خالص الشكر للمجهود المبذول ولكن لم اجد كود 2 لشهر فبراير وذلك لان نهاية الشهر 19/فبراير لان يوم 20 يوم جمعة وهو غير مدرج بالجدول وكذلك الحال مع شهر ماس

اريد الكود يكتب فى نهاية الشهر سواء 19 او 20

اريد تنسيق الارقام قياسى والعلامة العشرية بعد رقمين بدل من مزدوج

أخي الفاضل ، لم لا تقوم بطرح جميع المطلوب كاملاً بدلاً من النقاط المبعثرة 😅

على العموم ، هذا التعديل لما طلبت ، تفضل ، استبدل الكود للزر بالتالي :-

Private Sub btnGenerate_Click()
    Dim db As DAO.Database
    Dim tDef As DAO.TableDef
    Dim fld As DAO.Field
    Dim rs As DAO.Recordset
    Dim startDate As Date, endDate As Date, d As Date
    Dim yearInput As Integer
    Dim monthName As String
    Dim monthCode As Integer
    Dim shiftValue As Double
    Dim startDateTime As Date
    Dim endDateTime As Date
    Dim monthEndDate As Date
    Dim monthEndWorkDate As Date
    
    If IsNull(TxtYear) Then
        MsgBox "أدخل رقم السنة", vbExclamation + vbMsgBoxRight, ""
        Me.TxtYear.SetFocus
    Exit Sub
    End If
    
    yearInput = Me.TxtYear
    startDate = DateSerial(yearInput - 1, 12, 21)
    endDate = DateSerial(yearInput, 12, 20)
    On Error Resume Next
    DoCmd.DeleteObject acTable, "Salary"
    On Error GoTo 0
    
    Set db = CurrentDb
    db.Execute "CREATE TABLE Salary (" & _
           "ID AUTOINCREMENT PRIMARY KEY, " & _
           "WorkDate DATE, " & _
           "DayName TEXT(20), " & _
           "MonthName TEXT(20), " & _
           "monthCode LONG, " & _
           "shift CURRENCY, " & _
           "startDay DATE, " & _
           "endDay DATE)"
    
    Set tDef = db.TableDefs("Salary")
    
    Set fld = tDef.Fields("shift")
    On Error Resume Next
    fld.Properties("Format") = "#,##0.00"
    If Err.Number <> 0 Then
        Err.Clear
        fld.Properties.Append fld.CreateProperty("Format", dbText, "#,##0.00")
    End If
    
    fld.Properties("DecimalPlaces") = 2
    If Err.Number <> 0 Then
        Err.Clear
        fld.Properties.Append fld.CreateProperty("DecimalPlaces", dbInteger, 2)
    End If
    
    Set fld = tDef.Fields("startDay")
    On Error Resume Next
    fld.Properties("Format") = "hh:nn AM/PM"
    If Err.Number <> 0 Then
        Err.Clear
        fld.Properties.Append fld.CreateProperty("Format", dbText, "hh:nn AM/PM")
    End If
    
    Set fld = tDef.Fields("endDay")
    On Error Resume Next
    fld.Properties("Format") = "hh:nn AM/PM"
    If Err.Number <> 0 Then
        Err.Clear
        fld.Properties.Append fld.CreateProperty("Format", dbText, "hh:nn AM/PM")
    End If
    
    On Error GoTo 0
    
    Set fld = Nothing
    Set tDef = Nothing
    
    Set rs = db.OpenRecordset("Salary", dbOpenDynaset)
    
    monthCode = 0
    monthEndWorkDate = DateSerial(yearInput - 1, 12, 20)
    
    d = startDate
    Do While d <= endDate
        If Weekday(d, vbMonday) <> 5 And Weekday(d, vbMonday) <> 7 Then
            monthName = CustomMonth(d)
            
            monthCode = 0
            
            monthEndDate = DateSerial(Year(d), Month(d), 20)
            
            If Weekday(monthEndDate, vbMonday) = 5 Or Weekday(monthEndDate, vbMonday) = 7 Then
                monthEndWorkDate = monthEndDate
                Do
                    monthEndWorkDate = DateAdd("d", -1, monthEndWorkDate)
                Loop Until Weekday(monthEndWorkDate, vbMonday) <> 5 And Weekday(monthEndWorkDate, vbMonday) <> 7
            Else
                monthEndWorkDate = monthEndDate
            End If
            
            If d = monthEndWorkDate Then
                If Month(d) = 12 And Year(d) = yearInput - 1 Then
                    monthCode = 1
                ElseIf Month(d) = 1 And Year(d) = yearInput Then
                    monthCode = 1
                ElseIf Month(d) = 2 Then
                    monthCode = 2
                ElseIf Month(d) = 3 Then
                    monthCode = 3
                ElseIf Month(d) = 4 Then
                    monthCode = 4
                ElseIf Month(d) = 5 Then
                    monthCode = 5
                ElseIf Month(d) = 6 Then
                    monthCode = 6
                ElseIf Month(d) = 7 Then
                    monthCode = 7
                ElseIf Month(d) = 8 Then
                    monthCode = 8
                ElseIf Month(d) = 9 Then
                    monthCode = 9
                ElseIf Month(d) = 10 Then
                    monthCode = 10
                ElseIf Month(d) = 11 Then
                    monthCode = 11
                ElseIf Month(d) = 12 Then
                    monthCode = 12
                End If
            End If
            
            If Weekday(d, vbMonday) = 6 Or Weekday(d, vbMonday) = 3 Then
                shiftValue = 1
                startDateTime = DateAdd("n", 30, DateSerial(Year(d), Month(d), Day(d)) + TimeSerial(8, 0, 0))
                endDateTime = DateSerial(Year(d), Month(d), Day(d)) + TimeSerial(13, 30, 0)
            Else
                shiftValue = 1.2
                startDateTime = DateAdd("n", 10, DateSerial(Year(d), Month(d), Day(d)) + TimeSerial(8, 0, 0))
                endDateTime = DateSerial(Year(d), Month(d), Day(d)) + TimeSerial(14, 30, 0)
            End If
            
            rs.AddNew
            rs!WorkDate = d
            rs!DayName = Format(d, "dddd")
            rs!monthName = monthName
            If monthCode > 0 Then
                rs!monthCode = monthCode
            Else
                rs!monthCode = Null
            End If
            rs!shift = shiftValue
            rs!startDay = startDateTime
            rs!endDay = endDateTime
            rs.Update
        End If
        d = d + 1
    Loop
    
    rs.Close
    Set rs = Nothing
    
    db.TableDefs.Refresh
    
    Set db = Nothing
    
    MsgBox "تم إنشاء الجدول بنجاح", vbInformation + vbMsgBoxRight, ""
    DoCmd.SelectObject acTable, "Salary", True
End Sub

ملفك بعد التعديل :-

CalGen.zip

ديسمبر 22, 2025

منذ ساعه, kkhalifa1960 said:

مشاركة

هل تحققت من النتائج أستاذي العزيز :excl:

ديسمبر 22, 2025

5 ساعات مضت, jo_2010 said:

خالص الشكر للمجهول المبذول من حضرتك. شكررررا

تفضل ، استبدل كود الزر القديم بالكود التالي ، مع بقاء الدالة في المديول كما هي ..

Private Sub btnGenerate_Click()
    Dim db As DAO.Database
    Dim tDef As DAO.TableDef
    Dim fld As DAO.Field
    Dim rs As DAO.Recordset
    Dim startDate As Date, endDate As Date, d As Date
    Dim yearInput As Integer
    Dim monthName As String
    Dim monthCode As Integer
    Dim shiftValue As Double
    Dim startDateTime As Date
    Dim endDateTime As Date
    
    If IsNull(TxtYear) Then
        MsgBox "أدخل رقم السنة", vbExclamation + vbMsgBoxRight, ""
        Me.TxtYear.SetFocus
    Exit Sub
    End If
    
    yearInput = Me.TxtYear
    startDate = DateSerial(yearInput - 1, 12, 21)
    endDate = DateSerial(yearInput, 12, 20)
    On Error Resume Next
    DoCmd.DeleteObject acTable, "Salary"
    On Error GoTo 0
    
    Set db = CurrentDb
    db.Execute "CREATE TABLE Salary (ID AUTOINCREMENT PRIMARY KEY, WorkDate DATE, DayName TEXT(20), MonthName TEXT(20), monthCode LONG, shift DOUBLE, startDay DATE, endDay DATE)"
    
    Set tDef = db.TableDefs("Salary")
    
    Set fld = tDef.Fields("shift")
    On Error Resume Next
    fld.Properties("Format") = "0.00"
    If Err.Number <> 0 Then
        Err.Clear
        fld.Properties.Append fld.CreateProperty("Format", dbText, "0.00")
    End If
    
    fld.Properties("DecimalPlaces") = 2
    If Err.Number <> 0 Then
        Err.Clear
        fld.Properties.Append fld.CreateProperty("DecimalPlaces", dbInteger, 2)
    End If
    
    Set fld = tDef.Fields("startDay")
    On Error Resume Next
    fld.Properties("Format") = "hh:nn AM/PM"
    If Err.Number <> 0 Then
        Err.Clear
        fld.Properties.Append fld.CreateProperty("Format", dbText, "hh:nn AM/PM")
    End If
    
    Set fld = tDef.Fields("endDay")
    On Error Resume Next
    fld.Properties("Format") = "hh:nn AM/PM"
    If Err.Number <> 0 Then
        Err.Clear
        fld.Properties.Append fld.CreateProperty("Format", dbText, "hh:nn AM/PM")
    End If
    
    On Error GoTo 0
    
    Set fld = Nothing
    Set tDef = Nothing
    
    Set rs = db.OpenRecordset("Salary", dbOpenDynaset)
    
    monthCode = 0
    
    d = startDate
    Do While d <= endDate
        If Weekday(d, vbMonday) <> 5 And Weekday(d, vbMonday) <> 7 Then
            monthName = CustomMonth(d)
            
            monthCode = 0
            
            If Month(d) = 12 And Day(d) = 20 And Year(d) = yearInput - 1 Then
                monthCode = 1
            ElseIf Month(d) = 1 And Day(d) = 20 And Year(d) = yearInput Then
                monthCode = 1
            ElseIf Month(d) = 2 And Day(d) = 20 Then
                monthCode = 2
            ElseIf Month(d) = 3 And Day(d) = 20 Then
                monthCode = 3
            ElseIf Month(d) = 4 And Day(d) = 20 Then
                monthCode = 4
            ElseIf Month(d) = 5 And Day(d) = 20 Then
                monthCode = 5
            ElseIf Month(d) = 6 And Day(d) = 20 Then
                monthCode = 6
            ElseIf Month(d) = 7 And Day(d) = 20 Then
                monthCode = 7
            ElseIf Month(d) = 8 And Day(d) = 20 Then
                monthCode = 8
            ElseIf Month(d) = 9 And Day(d) = 20 Then
                monthCode = 9
            ElseIf Month(d) = 10 And Day(d) = 20 Then
                monthCode = 10
            ElseIf Month(d) = 11 And Day(d) = 20 Then
                monthCode = 11
            ElseIf Month(d) = 12 And Day(d) = 20 Then
                monthCode = 12
            End If
            
            If Weekday(d, vbMonday) = 7 Or Weekday(d, vbMonday) = 3 Then
                shiftValue = 1
                startDateTime = DateAdd("n", 30, DateSerial(Year(d), Month(d), Day(d)) + TimeSerial(8, 0, 0))
                endDateTime = DateSerial(Year(d), Month(d), Day(d)) + TimeSerial(13, 30, 0)
            Else
                shiftValue = 1.2
                startDateTime = DateAdd("n", 10, DateSerial(Year(d), Month(d), Day(d)) + TimeSerial(8, 0, 0))
                endDateTime = DateSerial(Year(d), Month(d), Day(d)) + TimeSerial(14, 30, 0)
            End If
            
            rs.AddNew
            rs!WorkDate = d
            rs!DayName = Format(d, "dddd")
            rs!monthName = monthName
            If monthCode > 0 Then
                rs!monthCode = monthCode
            Else
                rs!monthCode = Null
            End If
            rs!shift = shiftValue
            rs!startDay = startDateTime
            rs!endDay = endDateTime
            rs.Update
        End If
        d = d + 1
    Loop
    
    rs.Close
    Set rs = Nothing
    
    db.TableDefs.Refresh
    
    Set db = Nothing
    
    MsgBox "تم إنشاء الجدول بنجاح", vbInformation + vbMsgBoxRight, ""
    DoCmd.SelectObject acTable, "Salary", True
End Sub

ملفك بعد التعديل :-

CalGen.zip

ديسمبر 22, 2025

1 ساعه مضت, almarwny said:

مافيش هذا البرنامج

للأسف أخي الكريم ، لا أعلم ما هو هذا البرنامج ,,

ديسمبر 22, 2025

أخي @jo_2010 ، بدايةً ، وللإستفسار . هل الجدول هذا سيحتوي فقط على التواريخ التي تريدها للعام الذي ذكرته فقط !!!!!!!

يعني لو حددنا التاريخ لسنة 2025 ، وتم انشاء التواريخ كما تريد ، ومن ثم حددنا تاريخ سنة 2026 ، فهل تريد ان يبقى العامين معاً ؟؟؟؟

إن كان جوابك لا .. فخطر ببالي فكرة تتجسد بالدالة الصغيرة التالية :-

Public Function CustomMonth(d As Date) As String
    Dim m As Integer, y As Integer
    m = Month(d)
    y = Year(d)
    If Day(d) >= 21 Then
        m = m + 1
        If m = 13 Then
            m = 1
            y = y + 1
        End If
    End If
    CustomMonth = Format(DateSerial(y, m, 1), "MMMM")
End Function

وفي نموذجك ننشئ مربع النص TxtYear سنحدد السنة ، ومن الزر BtnGenerate ، سيتم تنفيذ الفكرة التالية طبعاً بعد استبعاد يومي الجمعة و الأحد من الأيام المضافة لكل اشهر , :-

Private Sub btnGenerate_Click()
    Dim db As DAO.Database
    Dim tDef As DAO.TableDef
    Dim rs As DAO.Recordset
    Dim startDate As Date, endDate As Date, d As Date
    Dim yearInput As Integer
    Dim monthName As String
    
    If IsNull(TxtYear) Then
        MsgBox "أدخل رقم السنة", vbExclamation + vbMsgBoxRight, ""
        Me.TxtYear.SetFocus
    Exit Sub
    End If
    
    yearInput = Me.TxtYear
    startDate = DateSerial(yearInput - 1, 12, 21)
    endDate = DateSerial(yearInput, 12, 20)
    On Error Resume Next
    DoCmd.DeleteObject acTable, "Salary"
    On Error GoTo 0
    
    Set db = CurrentDb
    db.Execute "CREATE TABLE Salary (ID AUTOINCREMENT PRIMARY KEY, WorkDate DATE, DayName TEXT(20), MonthName TEXT(20))"
    
    Set rs = db.OpenRecordset("Salary", dbOpenDynaset)
    
    d = startDate
    Do While d <= endDate
        If Weekday(d, vbMonday) <> 5 And Weekday(d, vbMonday) <> 7 Then
            rs.AddNew
            rs!WorkDate = d
            rs!DayName = Format(d, "dddd")
            rs!monthName = CustomMonth(d)
            rs.Update
        End If
        d = d + 1
    Loop
    
    rs.Close
    Set rs = Nothing
    Set db = Nothing
    
    MsgBox "تم إنشاء الجدول بنجاح", vbInformation + vbMsgBoxRight, ""
    DoCmd.SelectObject acTable, "Salary", True
End Sub

والفكرة تم تطبيقها على الملف التالي للتوضيح :-

CalGen.zip

ديسمبر 22, 2025

في 20‏/12‏/2025 at 17:06, محمد حسن2 said:

فهل من طريقة أو فكرة ؟

راجع هذا الموضوع :-

أو هذا الموضوع أيضاً ..

تسجيل الدخول

التقويم

المنتدى

مكتبة الموقع

معرض الصور

المدونات

الوسائط المتعددة

مشاركات المكتوبه بواسطه Foksh

Important Information