انشاء جدول بمواصفات خاصه

**jo_2010** · بالامس في 05:34

الخبراء الافاضل

بعد التحية

اريد انشاء جدول بمواصفات خاصة

اولا فى نموذج نعمل مربع نص وبجوارة زر

مثلا اكتب السنة ٢٠٢٦ فى مريع النص

واضغط علي الزر

يتم انشاء الجدول وليكن اسمة salary

اول حقل ترقيم تلقائي

تانى حقل التاريخ من ٢١ ديسمبر عام ٢٠٢٥ الي ٢٠ ديسمبر ٢٠٢٦ بدون ايام الجمعة والاحد

تالث حقل اسم اليوم أمام كل تاريخ

رابع حقل يكتب اسم الشهر مثلا من ٢١ ديسمبر ٢٠٢٥ الي ٢٠ يناير ٢٠٢٦ January

ومن ٢١ يناير ٢٠٢٦ الي ٢٠ فبراير ٢٠٢٦ يكتب اسم الشهر February وهكذا

شكرا للخبراء الافاضل

تم تعديل بالامس في 07:52 بواسطه jo_2010

**Foksh** · بالامس في 12:16

أخي @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

**jo_2010** · بالامس في 18:09

5 ساعات مضت, Foksh said:
أخي @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 27.61 kB · 7 downloads

معلمى الفاضل خالص الشكر على اهتمام حضرتك بطلبى أود إضافة بسيطة

نسيت إضافة باقى حقول الجدول

١_عمل حقل اسمة month code

وفي نهاية كل شهر يكتب بة رقم الشهر

مثال ٢٠ يناير ٢٠٢٦ يكتب بة ١

وفى ٢٠ فبراير ٢٠٢٦ يكتب ٢ وهكذا

٢_ عمل حقل باسم shift

يكتب بة 1.20امام كل الايام ماعدا

السبت والأربعاء يكتب 1.00

٣_ حقل start day يكتب الساعة ٨:١٠am

ماعدا السبت والأربعاء يكتب ٨:٣٠am

وحقل End day يكتب الساعة ٢:٣٠pm

ماعدا السبت والأربعاء يكتب ١:٣٠pm

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

تم تعديل بالامس في 18:20 بواسطه jo_2010

**kkhalifa1960** · بالامس في 21:47

مشاركة مع استاذ @Foksh تفضل استاذ @jo_2010 محاولتي . :fff:

image.gif.c1be6b7a02b470f2ca20cf38505b46ca.gif

Jo.rar

**Foksh** · بالامس في 22:51

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

**Foksh** · منذ 23 ساعات

منذ ساعه, kkhalifa1960 said:

مشاركة

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

**jo_2010** · منذ 15 ساعات

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

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

الخبير الفاصل Foksh

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

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

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

تم تعديل منذ 14 ساعات بواسطه jo_2010

**jo_2010** · منذ 14 ساعات

استاذى الفاضل

kkhalifa1960

شكرا لمحاولتك مساعدتى

لكن هناك خطا فى المطلوب اريد ان يبدا الشهر من 21 مثلا 21 ديسمبر 2025 الى 20 يناير 2026 يكتب اسم اشهر يناير وكود الشهر يكتب مرة واحدة غى نهاية الشهر رقم الشهر

**Foksh** · منذ 12 ساعات

2 ساعات مضت, 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 Number, 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) = 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

**jo_2010** · منذ 11 ساعات

1 ساعه مضت, Foksh 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
    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 Number, 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) = 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 32.38 kB · 2 downloads

الخبير الفاضل

اعتذر عن ازعاجك بكثرة طلباتى ولكنى اقوم بطلب بسيط واحاول الاستفادة منة وتطبيقة على اكثر من حقل لو نجح الامر تمام لولم ينجح اقوم باكمال طلبى

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

تسجيل الدخول

انشاء جدول بمواصفات خاصه

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

jo_2010

Foksh

jo_2010

kkhalifa1960

Foksh

Foksh

jo_2010

jo_2010

Foksh

jo_2010

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

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

تسجيل دخول

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

تصفح الموقع

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

Support

Important Information