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

[jo_2010]

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

بعد التحية 

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

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

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

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

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

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

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

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

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

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

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

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

[Foksh]

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