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

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

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

بعد التحية

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

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

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

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

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

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

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

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

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

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

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

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

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

أخي @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** · منذ 8 ساعات

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

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

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

**kkhalifa1960** · منذ 5 ساعات

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

image.gif.c1be6b7a02b470f2ca20cf38505b46ca.gif

Jo.rar

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

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** · منذ 3 ساعات

منذ ساعه, kkhalifa1960 said:

مشاركة

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

تسجيل الدخول

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

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

jo_2010

Foksh

jo_2010

kkhalifa1960

Foksh

Foksh

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

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

تسجيل دخول

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

تصفح الموقع

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

Support

Important Information