اذهب الي المحتوي
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
Custom Search

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

قام بنشر

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

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

اليوم اقدم لكم التالى 

الكود يهدف إلى إدارة الحقول والجداول في قاعدة بيانات

يتضمن الكود مجموعة من الإجراءات التي تمكن المستخدم من: 

إنشاء الجداول و الحقول في الجداول وتحديث خصائص الحقول مثل التسمية والوصف ويمكن إضافة البيانات إلى الجداول بشكل اختياري  الى الحقول كذلك اذا استدعت الحاجة الى ذلك 

كما يتيح الكود إضافة الحقول إلى الجداول إذا كانت غير موجودة أو تحديث البيانات داخل الحقول فى الجداول إذا كانت موجودة

يتم أيضًا دعم الحقول المتعددة الخيارات (MultipleChoice) من خلال التعداد FieldsTypes

يتم استخدام القاموس لتخزين الحقول ومعلوماتها، مما يتيح تنظيم البيانات بشكل مرن

يضمن الكود تحديث الجداول وإضافة الحقول والخصائص بشكل ديناميكي، مع إمكانية إضافة البيانات إذا كانت مطلوبة

الكود الرئيسي استخدام القواميس Dictionary بدون الحاجة إلى تفعيل مكتبة Microsoft Scripting Runtime

حتى لا يتوقف الكود عن العمل فى حال نقل الموديول الى قاعدة اخرى بدون تفعيل المكتبة

 

الموديول الرئيسي

 

Option Compare Database
Option Explicit

' تعريف تعداد لأنواع الحقول
Public Enum FieldsTypes
    dbBoolean = 1             ' نوع الحقل: Boolean (قيمة منطقية: صحيح أو خطأ)
    dbByte = 2                ' نوع الحقل: Byte (عدد صحيح صغير بين 0 و 255)
    dbInteger = 3             ' نوع الحقل: Integer (عدد صحيح بين -32,768 و 32,767)
    dbLong = 4                ' نوع الحقل: Long (عدد صحيح طويل بين -2,147,483,648 و 2,147,483,647)
    dbCurrency = 5            ' نوع الحقل: Currency (عدد عشري بدقة عالية لاستخداماته المالية)
    dbSingle = 6              ' نوع الحقل: Single (عدد عشري دقيق، ولكنه أقل دقة من Double)
    dbDouble = 7              ' نوع الحقل: Double (عدد عشري بدقة مزدوجة)
    dbDate = 8                ' نوع الحقل: Date (تاريخ/وقت)
    dbText = 10               ' نوع الحقل: Text (نص عادي يمكن تخزينه في الحقل)
    dbLongBinary = 11         ' نوع الحقل: Long Binary (بيانات ثنائية كبيرة الحجم)
    dbMemo = 12               ' نوع الحقل: Memo (نص طويل جدًا يمكن أن يحتوي على عدة آلاف من الأحرف)
    dbGUID = 15               ' نوع الحقل: GUID (معرف فريد عالميًا)
    dbBigInt = 16             ' نوع الحقل: Big Int (عدد صحيح كبير جدًا)
    dbVarBinary = 17          ' نوع الحقل: VarBinary (بيانات ثنائية متغيرة الحجم)
    dbNumeric = 19            ' نوع الحقل: Numeric (عدد عشري يستخدم عادة في الحسابات الدقيقة)
    dbMultipleChoice = 20     ' نوع الحقل: MultipleChoice (دعم الحقول متعددة الخيارات)
    dbAutoNumber = 21      ' نوع الحقل: AutoNumber (ترقيم تلقائي)
End Enum

' متغير عام لتخزين الحقول باستخدام القاموس
Public Fields As Object

' هذا الإجراء يقوم بإضافة حقل جديد إلى القاموس الذي يحتوي على الحقول المختلفة
Public Sub AddFieldToDictionary(fieldName As String, _
                                fieldType As FieldsTypes, _
                                Optional fieldCaption As String = "", _
                                Optional fieldDescription As String = "", _
                                Optional defaultValue As Variant = Null _
                               )
    ' إنشاء قاموس جديد لتخزين معلومات الحقل
    Dim fieldDict As Object
    Set fieldDict = CreateDictionary()
    
    ' إضافة الحقول إلى القاموس
    fieldDict("Name") = fieldName                   ' اسم الحقل
    fieldDict("Type") = fieldType                   ' نوع الحقل (من تعداد FieldsTypes)
    fieldDict("Caption") = fieldCaption             ' التسمية التي تظهر في واجهة المستخدم (اختياري)
    fieldDict("Description") = fieldDescription     ' وصف الحقل (اختياري)
    fieldDict("DefaultValue") = defaultValue        ' القيمة الافتراضية (اختياري)
    
    ' التحقق مما إذا كان القاموس فارغًا، وإذا كان كذلك يتم تهيئته باستخدام قاموس جديد
    If Fields Is Nothing Then Set Fields = CreateObject("Scripting.Dictionary")
    
    ' إضافة القاموس الخاص بالحقل إلى القاموس العام باستخدام اسم الحقل كمفتاح
    Set Fields(fieldName) = fieldDict
End Sub

' هذه الدالة تقوم بإنشاء قاموس جديد عند الحاجة إليها
Public Function CreateDictionary() As Object
    ' إنشاء قاموس جديد باستخدام "Scripting.Dictionary"
    Set CreateDictionary = CreateObject("Scripting.Dictionary")
End Function

' هذه الدالة تقوم بالتحقق إذا كان الجدول المطلوب موجودًا في قاعدة البيانات
Public Function TableExists(tableName As String) As Boolean
    Dim tdf As DAO.TableDef
    ' استعراض جميع الجداول في قاعدة البيانات
    For Each tdf In CurrentDb.TableDefs
        ' إذا كان اسم الجدول يتطابق مع الاسم المطلوب
        If tdf.Name = tableName Then
            '(الجدول موجود) إذا  تم العثور على الجدول
            TableExists = True
            Exit Function
        End If
    Next tdf
    '(الجدول غير موجود) إذا لم يتم العثور على الجدول
    TableExists = False
End Function

' هذا الإجراء يقوم بإنشاء الجدول إذا لم يكن موجودًا أو تحديثه إذا كان موجودًا
Public Sub CreateTable(tableName As String, Fields As Object)
    Dim db As DAO.Database
    Dim tdf As DAO.TableDef
    Dim fld As DAO.Field
    Dim fieldDict As Object
    Dim key As Variant

    Set db = CurrentDb()
    Set tdf = db.CreateTableDef(tableName)

    ' التأكد من أن القاموس غير فارغ
    If Fields Is Nothing Then Exit Sub

    ' إضافة الحقول إلى الجدول
    For Each key In Fields.Keys
        Set fieldDict = Fields(key)
        
        ' إنشاء حقل جديد في الجدول
        If fieldDict("Type") <> dbAutoNumber Then
            Set fld = tdf.CreateField(fieldDict("Name"), fieldDict("Type"))
        Else
            Set fld = tdf.CreateField(fieldDict("Name"), dbLong)
            fld.Attributes = dbAutoIncrField
        End If
        
        ' إذا كان هناك قيمة افتراضية يتم إضافتها
        If fieldDict.Exists("DefaultValue") And Not IsNull(fieldDict("DefaultValue")) Then
            fld.defaultValue = fieldDict("DefaultValue")
        End If
        
        ' إضافة الحقل إلى الجدول
        tdf.Fields.Append fld
    Next key

    ' إضافة الجدول إلى قاعدة البيانات
    db.TableDefs.Append tdf
    db.TableDefs.Refresh
    Application.RefreshDatabaseWindow

    ' تحرير المتغيرات
    Set fld = Nothing
    Set tdf = Nothing
    Set db = Nothing
End Sub

' هذه الدالة تقوم بالتحقق من وجود الحقل في الجدول
Public Function FieldExists(tdf As DAO.TableDef, fieldName As String) As Boolean
    Dim fld As DAO.Field
    ' استعراض جميع الحقول في الجدول
    For Each fld In tdf.Fields
        ' إذا كان اسم الحقل يتطابق مع الاسم المطلوب
        If fld.Name = fieldName Then
            FieldExists = True
            Exit Function
        End If
    Next fld
    ' الحقل غير موجود
    FieldExists = False
End Function

' هذا الإجراء يقوم بإضافة الحقول إلى الجدول إذا لم تكن موجودة
Public Sub AddFieldsIfNeeded(tdf As DAO.TableDef, Fields As Object)
    Dim fieldDict As Object
    Dim fld As DAO.Field
    Dim key As Variant
    
    ' التأكد من أن القاموس غير فارغ
    If Fields Is Nothing Then Exit Sub
        ' البحث عن أول حقل من النوع AutoNumber في القاموس
        For Each key In Fields.Keys
            Set fieldDict = Fields(key)
            ' التحقق من عدم وجود حقل بنفس الاسم
            If Not FieldExists(tdf, fieldDict("Name")) Then
                If fieldDict("Type") <> dbAutoNumber Then
                    Set fld = tdf.CreateField(fieldDict("Name"), fieldDict("Type"))
                Else
                    Set fld = tdf.CreateField(fieldDict("Name"), dbLong)
                    fld.Attributes = dbAutoIncrField
                End If
                tdf.Fields.Append fld
            End If
        Next key
End Sub

' هذا الإجراء يقوم بإضافة خصائص الحقول في الجدول
Public Sub AddFieldProperties(tableName As String, Fields As Object)
    Dim db As DAO.Database
    Dim tdf As DAO.TableDef
    Dim fld As DAO.Field
    Dim fieldDict As Object
    Dim key As Variant
    Dim prop As DAO.Property

    Set db = CurrentDb()
    Set tdf = db.TableDefs(tableName)

    ' التأكد من أن القاموس غير فارغ
    If Fields Is Nothing Then Exit Sub

    ' استعراض الحقول في القاموس وتحديث خصائصها في الجدول
    For Each key In Fields.Keys
        Set fieldDict = Fields(key)
        
        ' إذا كان الحقل موجودًا في الجدول، يتم تحديث خصائصه
        If FieldExists(tdf, fieldDict("Name")) Then
            Set fld = tdf.Fields(fieldDict("Name"))
            
            ' إضافة أو تحديث التسمية ( عنوان الحقل/التسمية التي تظهر في واجهة المستخدم ) إذا كانت موجودة
            If fieldDict.Exists("Caption") And fieldDict("Caption") <> "" Then
                On Error Resume Next
                fld.Properties("Caption") = fieldDict("Caption")
                If Err.Number <> 0 Then
                    Err.Clear
                    Set prop = fld.CreateProperty("Caption", dbText, fieldDict("Caption"))
                    fld.Properties.Append prop
                End If
                On Error GoTo 0
            End If
            ' إضافة أو تحديث الوصف (الوصف) إذا كان موجودًا
            If fieldDict.Exists("Description") And fieldDict("Description") <> "" Then
                On Error Resume Next
                fld.Properties("Description") = fieldDict("Description")
                If Err.Number <> 0 Then
                    Err.Clear
                    Set prop = fld.CreateProperty("Description", dbText, fieldDict("Description"))
                    fld.Properties.Append prop
                End If
                On Error GoTo 0
            End If
        End If
    Next key
End Sub

' هذا الإجراء يقوم بإنشاء الجدول أو تحديثه وإضافة البيانات إذا كانت موجودة
Public Sub CreateOrUpdateTable(tableName As String, Fields As Object)
    Dim db As DAO.Database
    Dim tdf As DAO.TableDef
    
    Set db = CurrentDb()
    
    If Not TableExists(tableName) Then
        CreateTable tableName, Fields
    Else
        Set tdf = db.TableDefs(tableName)
        AddFieldsIfNeeded tdf, Fields
    End If
    
    AddFieldProperties tableName, Fields
    Application.RefreshDatabaseWindow
End Sub

' هذا الإجراء يقوم بإنشاء الجدول أو تحديثه بالإضافة إلى إضافة البيانات إذا كانت موجودة
Public Sub CreateOrUpdateTableAndAddData(tableName As String, _
                                         Fields As Object, _
                                         Optional fieldValues As Object, _
                                         Optional bAddData As Boolean = False _
                                        )
    Dim db As DAO.Database
    Dim tdf As DAO.TableDef
    Dim rst As DAO.Recordset
    Dim key As Variant
    Dim fieldValue As Variant
    Dim isEmpty As Boolean
    Dim fieldName As String
    
    Set db = CurrentDb()
    
    If Not TableExists(tableName) Then
        CreateTable tableName, Fields
    Else
        Set tdf = db.TableDefs(tableName)
        AddFieldsIfNeeded tdf, Fields
    End If
    
    ' إضافة البيانات إذا كانت القيمة للعلم صحيحة
    If bAddData Then
        Set rst = db.OpenRecordset(tableName, dbOpenDynaset)
        isEmpty = (rst.RecordCount = 0)
            If isEmpty Then
                rst.AddNew
                For Each key In fieldValues.Keys
                    fieldName = key
                    fieldValue = fieldValues(key)
                    rst(fieldName) = fieldValue
                Next key
                rst.Update
            Else
                rst.MoveFirst
                For Each key In fieldValues.Keys
                    fieldName = key
                    fieldValue = fieldValues(key)
                    If IsNull(rst(fieldName)) Or (rst(fieldName) <> fieldValue) Then
                        rst.Edit
                        rst(fieldName) = fieldValue
                        rst.Update
                    End If
                Next key
            End If
    End If
    
    ' إضافة خصائص الحقول للجدول المحدد
    AddFieldProperties tableName, Fields
    ' تحديث نافذة قاعدة البيانات
    Application.RefreshDatabaseWindow
    
End Sub

لاستدعاء الكود بدون اضافة اى بيانات داخل الحقول
 

' هذا الإجراء يقوم بتهيئة الجدول فقط بدون البيانات الخاصة بالتصميم
Public Sub SetupDesignerTableOnly()
    
    Dim tblName As String
    tblName = "UsysTblDesignerInformation"
    
    Set Fields = CreateDictionary()
    
    ' إضافة الحقول و معلومات كل حقل  " اسم الحقل - نوع الحقل -التسمية التي تظهر في واجهة المستخدم  (اختياري) - وصف الحقل  (اختياري) - القيمة الافتراضية (اختياري)
    AddFieldToDictionary "ID", dbAutoNumber, "ID", "المعرف (التلقائي)"
    AddFieldToDictionary "DesignerPlatform", dbText, "Designer Platform", "اسم المنصة"
    AddFieldToDictionary "FullName", dbText, "Full Name", "الاسم الكامل"
    AddFieldToDictionary "Email", dbText, "Email Address", "البريد الإلكتروني"
    AddFieldToDictionary "PhoneNumber", dbText, "Phone Number", "رقم الهاتف"
    AddFieldToDictionary "DesignSpecialty", dbText, "Design Specialty", "مجال التخصص"
    AddFieldToDictionary "PortfolioLink", dbText, "Portfolio Link", "رابط المحفظة"
    AddFieldToDictionary "CreationDate", dbDate, "Creation Date", "تاريخ التسجيل", "NOW()"
    

    
    ' إنشاء أو تحديث الجدول بالإضافة إلى إضافة البيانات
    CreateOrUpdateTableAndAddData tblName, Fields

End Sub


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

' هذا الإجراء يقوم بتهيئة البيانات الخاصة بالتصميم
Public Sub SetupDesignerData()
    
    Dim fieldValues As Object
    Dim tblName As String
    tblName = "UsysTblDesignerInformation"
    
    Set Fields = CreateDictionary()
    Set fieldValues = CreateDictionary()
    
    ' إضافة الحقول و معلومات كل حقل  " اسم الحقل - نوع الحقل -التسمية التي تظهر في واجهة المستخدم  (اختياري) - وصف الحقل  (اختياري) - القيمة الافتراضية (اختياري)
    AddFieldToDictionary "ID", dbAutoNumber, "ID", "المعرف (التلقائي)"
    AddFieldToDictionary "DesignerPlatform", dbText, "Designer Platform", "اسم المنصة"
    AddFieldToDictionary "FullName", dbText, "Full Name", "الاسم الكامل"
    AddFieldToDictionary "Email", dbText, "Email Address", "البريد الإلكتروني"
    AddFieldToDictionary "PhoneNumber", dbText, "Phone Number", "رقم الهاتف"
    AddFieldToDictionary "DesignSpecialty", dbText, "Design Specialty", "مجال التخصص"
    AddFieldToDictionary "PortfolioLink", dbText, "Portfolio Link", "رابط المحفظة"
    AddFieldToDictionary "CreationDate", dbDate, "Creation Date", "تاريخ التسجيل", "NOW()"
    
    ' إضافة القيم الخاصة لكل حقل
    fieldValues("DesignerPlatform") = "Example Designer Platform™"
    fieldValues("FullName") = "Example Designer Name"
    fieldValues("Email") = "example.designer@email.com"
    fieldValues("PhoneNumber") = "+000 Example Designer Phone Number"
    fieldValues("DesignSpecialty") = "Example Designer Specialty"
    fieldValues("PortfolioLink") = "https://example.com/designer-portfolio"
    fieldValues("CreationDate") = Now
    
    ' إنشاء أو تحديث الجدول بالإضافة إلى إضافة البيانات
    CreateOrUpdateTableAndAddData tblName, Fields, fieldValues, True

End Sub



وكما ذكرت الموضوع مطروح للتجربة والنقاش  .... اتمنى وارجوا من حضراتكم التفاعل بالنقاش وابداء الرأى

  • Like 1
  • Thanks 1
قام بنشر

كود راااااااائع جدا حبيبنا @ابو جودي ويسهل العمل 🙂 

لا يقل جودة عن روائعك اللي عودتنا عليها .... 😊💪

 

  • Thanks 1
قام بنشر

استاذنا العزيز @ابو جودي

مشتاقون لك واعمالك الجميلة والرائعة ...

بس ياعمي انت حتخرب شغل على المبرمجين 😂

دة عندنا علشان المبرمج يضيف جدول اضافي ...بياخد الشيء الفلاني

  • Haha 1
قام بنشر
9 ساعات مضت, Moosak said:

كود راااااااائع جدا حبيبنا @ابو جودي ويسهل العمل 🙂 

لا يقل جودة عن روائعك اللي عودتنا عليها .... 😊💪

 

2 ساعات مضت, Eng.Qassim said:

استاذنا العزيز @ابو جودي

مشتاقون لك واعمالك الجميلة والرائعة ...

بس ياعمي انت حتخرب شغل على المبرمجين 😂

دة عندنا علشان المبرمج يضيف جدول اضافي ...بياخد الشيء الفلاني

بعض الناس متصالح مع نفسه وقانع بما رزقه الله .. والعطاء والبذل سجية  تجري في عروقه منحها الله اياه

لا نملك له ولأمثاله الا دعواتنا الصادقة له بان يزيده الله علما ورفعه ويبارك له في وقته وماله وأهله وولده

  • Like 3
قام بنشر

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

اولا وقبل كل شئ وليس آخرا التمس من كل اساتذتى العذر فى التأخر فى الرد على حضراتكم لظروف خارجه عن ارادتى

في 10‏/2‏/2025 at 16:15, Moosak said:

كود راااااااائع جدا حبيبنا @ابو جودي ويسهل العمل 🙂 

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

 

-----------------------------------------------

في 10‏/2‏/2025 at 22:47, Eng.Qassim said:

مشتاقون لك واعمالك الجميلة والرائعة ...

بس ياعمي انت حتخرب شغل على المبرمجين 😂

دة عندنا علشان المبرمج يضيف جدول اضافي ...بياخد الشيء الفلاني

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

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

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

 

 

----------------------------------------

في 11‏/2‏/2025 at 01:42, ابوخليل said:

بعض الناس متصالح مع نفسه وقانع بما رزقه الله .. والعطاء والبذل سجية  تجري في عروقه منحها الله اياه

لا نملك له ولأمثاله الا دعواتنا الصادقة له بان يزيده الله علما ورفعه ويبارك له في وقته وماله وأهله وولده

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

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

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

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

في الختام، كنت أتمنى الاطلاع على نتائج تجاربكم الكريمة وعلى آرائكم فيما يتعلق بالأفكار وآلية العمل، سواء كان رضا أو نقدًا بنّاء.

إن شاء الله، جاري العمل على إعداد نسخة محسّنة تشمل جميع التفاصيل وتوفر تحكمًا أكثر تفصيلًا وعمقًا، حتى يأخذ كل ذي حق حقه.

أستاذي الجليل ومعلمي القدير وأخي الحبيب الأستاذ @Foksh

 أتوجه إليكم بخالص الشكر والتقدير على هذا التحديث، فقد اعتمدت أفكاري الجديدة – بعد توفيق الله عز وجل – على أفكاركم الرائعة التي اقتبستها من أفكاركم فى أحد أعمالكم ، خاصة ما يتعلق بالتحكم في خصائص حجم الحقل.

هذا دفعني للتطلع أيضًا إلى إضافة مزيد من التحكم في إعدادات خصائص الحقل للتنسيق بشكل أفضل.

 

قام بنشر (معدل)
41 دقائق مضت, ابو جودي said:

أستاذي الجليل ومعلمي القدير وأخي الحبيب الأستاذ @Foksh

 أتوجه إليكم بخالص الشكر والتقدير على هذا التحديث، فقد اعتمدت أفكاري الجديدة – بعد توفيق الله عز وجل – على أفكاركم الرائعة التي اقتبستها من أفكاركم فى أحد أعمالكم ، خاصة ما يتعلق بالتحكم في خصائص حجم الحقل.

هذا دفعني للتطلع أيضًا إلى إضافة مزيد من التحكم في إعدادات خصائص الحقل للتنسيق بشكل أفضل.

استغفر الله العظيم ، أخي العزيز الأستاذ @ابو جودي ، أسأل الله لكم الفلاح والنجاح في الدنيا والآخرة ، وأن يزيدكم الله من علمه لما علمكم ,, < انتهينا من دي !!

 

:angry: ايه الكلام ده يا عم الحج .. انت حتسيح بقلب المنطقة :blink: !!!!

هو انا كنت عملت ايه !! ولا هي تتبلاني وخلاااص :') .

وبعدين انا كنت بجاوب هنا أو هناك :biggrin: ؛ تنكر !!!

 

صدقني لهو شرف لي أن أشاطرك الأفكار بكل ود وحب .. شكراً على كلامك الجميل ( محدش يصدقه :blink:)

تم تعديل بواسطه Foksh
قام بنشر
1 ساعه مضت, Foksh said:

هو انا كنت عملت ايه !! 

المعلم الكريم نعمه والعلم نعمه والاصدقاء الصالحين الاوفياء نعمه

وعدم شكر النعم سبب زوالها 

وشكر ونعمة العلم نقله ونشره وامانه نقل العلم ذكر مصدره واحقاق الحقل نسب الفضل لاهل الفضل

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

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

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

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

شكر الله لكم حسن صنيعكم معنا :fff: 

  • Like 1
قام بنشر

والان مع الاصدار الجديد
ـــــــــــــــــــــــــــــــــــــــــ

 

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

لنعطى مثلا للوحدة النمطية العامة الاسم : basTablesCreator

Option Compare Database
Option Explicit

' متغير عام لتخزين الحقول باستخدام القاموس
Public Fields As Object

' تعريف تعداد لأنواع الحقول المتاحة في قاعدة البيانات
Public Enum FieldsTypes
    dbBoolean = 1          ' نوع الحقل: Yes/No (قيمة منطقية)
    dbByte = 2             ' نوع الحقل: Byte (عدد صحيح صغير بين 0 و 255)
    dbInteger = 3          ' نوع الحقل: Integer (عدد صحيح بين -32,768 و 32,767)
    dbLong = 4             ' نوع الحقل: Long Integer (عدد صحيح طويل بين -2,147,483,648 و 2,147,483,647)
    dbCurrency = 5         ' نوع الحقل: Currency (عدد عشري بدقة عالية للحسابات المالية)
    dbSingle = 6           ' نوع الحقل: Single (عدد عشري بدقة بسيطة)
    dbDouble = 7           ' نوع الحقل: Double (عدد عشري بدقة مزدوجة)
    dbDate = 8             ' نوع الحقل: Date/Time (تاريخ ووقت)
    dbText = 10            ' نوع الحقل: Text (نص عادي يصل إلى 255 حرفًا)
    dbMemo = 12            ' نوع الحقل: Memo (نص طويل جدًا)
    dbAutoNumber = 15      ' نوع الحقل: AutoNumber (ترقيم تلقائي)
    dbBinary = 128         ' نوع الحقل: Binary (بيانات ثنائية صغيرة)
    dbVarBinary = 205      ' نوع الحقل: OLE Object (بيانات ثنائية كبيرة مثل ملفات OLE)
    dbAttachment = 101     ' نوع الحقل: Attachment (ملفات مرفقة)
    dbBigInt = 16          ' نوع الحقل: Big Integer (عدد صحيح كبير جدًا، 64 بت)
    dbMultipleChoice = 109 ' نوع الحقل: Multiple Choice (حقل متعدد الخيارات)
End Enum

' دالة لإنشاء قاموس جديد عند الحاجة إليه
Public Function CreateDictionary() As Object
    ' إنشاء قاموس جديد باستخدام "Scripting.Dictionary"
    Set CreateDictionary = CreateObject("Scripting.Dictionary")
End Function

' إجراء لإضافة حقل جديد إلى القاموس الذي يحتوي على الحقول المختلفة
Public Sub AddFieldToDictionary(fieldName As String, _
                                fieldType As FieldsTypes, _
                                Optional fieldSize As Variant, _
                                Optional fieldFormat As String = "", _
                                Optional defaultValue As Variant = Null, _
                                Optional fieldCaption As String = "", _
                                Optional fieldDescription As String = "" _
                               )
    ' إنشاء قاموس جديد لتخزين معلومات الحقل
    Dim fieldDict As Object
    Set fieldDict = CreateObject("Scripting.Dictionary")

    ' قاموس لأحجام الحقول الافتراضية بناءً على نوع الحقل
    Dim defaultFieldSizes As Object
    Set defaultFieldSizes = CreateObject("Scripting.Dictionary")

    ' قاموس للتنسيقات الافتراضية بناءً على نوع الحقل
    Dim defaultFormats As Object
    Set defaultFormats = CreateObject("Scripting.Dictionary")

    ' إضافة الأحجام الافتراضية لكل نوع حقل
    With defaultFieldSizes
        .Add dbBoolean, 0                  ' لا يحتاج Boolean إلى حجم
        .Add dbByte, 0                     ' Byte لا يحتاج إلى حجم
        .Add dbInteger, 0                  ' Integer لا يحتاج إلى حجم
        .Add dbLong, 0                     ' Long لا يحتاج إلى حجم
        .Add dbCurrency, 0                 ' Currency لا يحتاج إلى حجم
        .Add dbSingle, 0                   ' Single لا يحتاج إلى حجم
        .Add dbDouble, 0                   ' Double لا يحتاج إلى حجم
        .Add dbDate, 0                     ' Date/Time لا يحتاج إلى حجم
        .Add dbText, 255                   ' Text: الحجم الافتراضي هو 255
        .Add dbMemo, 0                     ' Memo لا يحتاج إلى حجم
        .Add dbBigInt, 0                   ' BigInt لا يحتاج إلى حجم
        .Add dbVarBinary, 0                ' VarBinary لا يحتاج إلى حجم
        .Add dbNumeric, 0                  ' Numeric لا يحتاج إلى حجم
        .Add dbMultipleChoice, 0           ' Multiple Choice لا يحتاج إلى حجم
        .Add dbAutoNumber, 0               ' AutoNumber لا يحتاج إلى حجم
        .Add dbAttachment, 0               ' Attachment لا يحتاج إلى حجم
    End With

    ' إضافة التنسيقات الافتراضية لكل نوع حقل
    With defaultFormats
        .Add dbBoolean, "Yes/No"           ' تنسيق Boolean الافتراضي
        .Add dbByte, ""                    ' لا يوجد تنسيق افتراضي لـ Byte
        .Add dbInteger, ""                 ' لا يوجد تنسيق افتراضي لـ Integer
        .Add dbLong, ""                    ' لا يوجد تنسيق افتراضي لـ Long
        .Add dbCurrency, "Currency"        ' تنسيق Currency الافتراضي
        .Add dbSingle, "Standard"          ' تنسيق Single الافتراضي
        .Add dbDouble, "Standard"          ' تنسيق Double الافتراضي
        .Add dbDate, "Short Date"          ' تنسيق Date/Time الافتراضي
        .Add dbText, ""                    ' لا يوجد تنسيق افتراضي لـ Text
        .Add dbMemo, ""                    ' لا يوجد تنسيق افتراضي لـ Memo
        .Add dbBigInt, ""                  ' لا يوجد تنسيق افتراضي لـ BigInt
        .Add dbVarBinary, ""               ' لا يوجد تنسيق افتراضي لـ VarBinary
        .Add dbNumeric, ""                 ' لا يوجد تنسيق افتراضي لـ Numeric
        .Add dbMultipleChoice, ""          ' لا يوجد تنسيق افتراضي لـ Multiple Choice
        .Add dbAutoNumber, ""              ' لا يوجد تنسيق افتراضي لـ AutoNumber
        .Add dbAttachment, ""              ' لا يوجد تنسيق افتراضي لـ Attachment
    End With

    ' التحقق من إذا لم يتم تحديد fieldSize، نستخدم القيمة الافتراضية من القاموس
    If IsMissing(fieldSize) Or isEmpty(fieldSize) Then
        If defaultFieldSizes.exists(fieldType) Then
            fieldSize = defaultFieldSizes(fieldType)
        Else
            fieldSize = 0 ' إذا لم يكن النوع معروفًا، نستخدم 0 كقيمة افتراضية
        End If
    End If

    ' التحقق من إذا لم يتم تحديد fieldFormat، نستخدم القيمة الافتراضية من القاموس
    If fieldFormat = "" Then
        If defaultFormats.exists(fieldType) Then
            fieldFormat = defaultFormats(fieldType)
        End If
    End If

    ' إضافة الحقول إلى القاموس مع طباعة القيم في النافذة الفورية
    fieldDict("Name") = fieldName
    fieldDict("Type") = fieldType
    fieldDict("Size") = fieldSize
    fieldDict("Caption") = fieldCaption
    fieldDict("Description") = fieldDescription
    fieldDict("DefaultValue") = defaultValue
    fieldDict("Format") = fieldFormat

    ' التحقق من إذا كان القاموس فارغًا، وإذا كان كذلك يتم تهيئته باستخدام قاموس جديد
    If Fields Is Nothing Then Set Fields = CreateObject("Scripting.Dictionary")

    ' إضافة القاموس الخاص بالحقل إلى القاموس العام باستخدام اسم الحقل كمفتاح
    Set Fields(fieldName) = fieldDict
End Sub

' هذه الدالة تقوم بالتحقق إذا كان الجدول المطلوب موجودًا في قاعدة البيانات
Public Function IsTableExist(tableName As String) As Boolean
    Dim tdf As DAO.TableDef
    ' استعراض جميع الجداول في قاعدة البيانات
    For Each tdf In CurrentDb.TableDefs
        ' إذا كان اسم الجدول يتطابق مع الاسم المطلوب
        If tdf.Name = tableName Then
            '(الجدول موجود) إذا تم العثور على الجدول
            IsTableExist = True
            Exit Function
        End If
    Next tdf
    '(الجدول غير موجود) إذا لم يتم العثور على الجدول
    IsTableExist = False
End Function

' هذا الإجراء يقوم بإنشاء الجدول إذا لم يكن موجودًا أو تحديثه إذا كان موجودًا
Public Sub CreateNewTable(tableName As String, Fields As Object)
    Dim db As DAO.Database
    Dim tdf As DAO.TableDef
    Dim fld As DAO.Field
    Dim fieldDict As Object
    Dim key As Variant

    ' الحصول على قاعدة البيانات الحالية
    Set db = CurrentDb()
    ' إنشاء كائن TableDef لتمثيل الجدول
    Set tdf = db.CreateTableDef(tableName)

    ' التأكد من أن القاموس غير فارغ
    If Fields Is Nothing Then Exit Sub

    ' إضافة الحقول إلى الجدول
    For Each key In Fields.Keys
        ' الحصول على القاموس الخاص بكل حقل
        Set fieldDict = Fields(key)

        ' إنشاء حقل جديد في الجدول بناءً على نوع الحقل
        If fieldDict("Type") <> dbAutoNumber Then
            Set fld = tdf.CreateField(fieldDict("Name"), fieldDict("Type"), fieldDict("Size"))
        Else
            ' إذا كان نوع الحقل هو dbAutoNumber، يتم إنشاء حقل من النوع dbLong مع تعيينه كحقل تلقائي
            Set fld = tdf.CreateField(fieldDict("Name"), dbLong)
            fld.Attributes = dbAutoIncrField ' تعيين الحقل كـ AutoNumber
        End If

        ' تعيين القيمة الافتراضية إذا كانت محددة
        If Not IsNull(fieldDict("DefaultValue")) And fieldDict("DefaultValue") <> "" Then
            fld.defaultValue = fieldDict("DefaultValue")
        End If

        ' إضافة الحقل إلى الجدول
        tdf.Fields.Append fld
    Next key

    ' إضافة الجدول إلى قاعدة البيانات
    db.TableDefs.Append tdf
End Sub

' هذه الدالة تقوم بالتحقق من وجود الحقل في الجدول
Public Function IsFieldExist(tdf As DAO.TableDef, fieldName As String) As Boolean
    Dim fld As DAO.Field
    ' استعراض جميع الحقول في الجدول
    For Each fld In tdf.Fields
        ' إذا كان اسم الحقل يتطابق مع الاسم المطلوب
        If fld.Name = fieldName Then
            ' (الحقل موجود) إذا تم العثور على الحقل
            IsFieldExist = True
            Exit Function
        End If
    Next fld
    ' (الحقل غير موجود) إذا لم يتم العثور على الحقل
    IsFieldExist = False
End Function

' هذا الإجراء يقوم بإضافة الحقول إلى الجدول إذا لم تكن موجودة
Public Sub EnsureFieldsExist(tdf As DAO.TableDef, Fields As Object)
    Dim fieldDict As Object
    Dim fld As DAO.Field
    Dim key As Variant

    ' التأكد من أن القاموس غير فارغ
    If Fields Is Nothing Then Exit Sub

    ' البحث عن أول حقل من النوع AutoNumber في القاموس
    For Each key In Fields.Keys
        Set fieldDict = Fields(key)

        ' التحقق من عدم وجود حقل بنفس الاسم
        If Not IsFieldExist(tdf, fieldDict("Name")) Then
            ' إذا لم يكن الحقل من نوع AutoNumber، يتم إضافته بالخصائص المحددة
            If fieldDict("Type") <> dbAutoNumber Then
                Set fld = tdf.CreateField(fieldDict("Name"), fieldDict("Type"))
            Else
                ' إذا كان نوع الحقل هو AutoNumber، يتم إنشاء حقل من النوع dbLong مع تعيينه كحقل تلقائي
                Set fld = tdf.CreateField(fieldDict("Name"), dbLong)
                fld.Attributes = dbAutoIncrField ' تعيين الحقل كـ AutoNumber
            End If
            ' إضافة الحقل إلى الجدول
            tdf.Fields.Append fld
        End If
    Next key
End Sub

' هذا الإجراء يقوم بإضافة أو تحديث خصائص الحقول في الجدول
Public Sub SetFieldProperties(tableName As String, Fields As Object)
    Dim db As DAO.Database
    Dim tdf As DAO.TableDef
    Dim fld As DAO.Field
    Dim fieldDict As Object
    Dim key As Variant
    Dim prop As DAO.Property

    ' الحصول على قاعدة البيانات الحالية
    Set db = CurrentDb()
    ' الحصول على الكائن TableDef للجدول الذي سيتم التحديث فيه
    Set tdf = db.TableDefs(tableName)

    ' التأكد من أن القاموس غير فارغ
    If Fields Is Nothing Then Exit Sub

    ' استعراض الحقول في القاموس وتحديث خصائصها في الجدول
    For Each key In Fields.Keys
        Set fieldDict = Fields(key)

        ' إذا كان الحقل موجودًا في الجدول، يتم تحديث خصائصه
        If IsFieldExist(tdf, fieldDict("Name")) Then
            Set fld = tdf.Fields(fieldDict("Name"))

            ' إضافة أو تحديث التسمية (Caption) إذا كانت موجودة
            If fieldDict.exists("Caption") And fieldDict("Caption") <> "" Then
                On Error Resume Next
                fld.Properties.Delete "Caption" ' حذف التسمية الحالية إذا كانت موجودة
                On Error GoTo 0
                ' إضافة التسمية الجديدة
                fld.Properties.Append fld.CreateProperty("Caption", dbText, fieldDict("Caption"))
            End If

            ' إضافة أو تحديث الوصف (Description) إذا كان موجودًا
            If fieldDict.exists("Description") And fieldDict("Description") <> "" Then
                On Error Resume Next
                fld.Properties.Delete "Description" ' حذف الوصف الحالي إذا كان موجودًا
                On Error GoTo 0
                ' إضافة الوصف الجديد
                fld.Properties.Append fld.CreateProperty("Description", dbText, fieldDict("Description"))
            End If

            ' إضافة أو تحديث التنسيق (Format) إذا كان موجودًا
            If fieldDict.exists("Format") And fieldDict("Format") <> "" Then
                On Error Resume Next
                fld.Properties.Delete "Format" ' حذف التنسيق الحالي إذا كان موجودًا
                On Error GoTo 0
                ' إضافة التنسيق الجديد
                fld.Properties.Append fld.CreateProperty("Format", dbText, fieldDict("Format"))
            End If

            ' تحديث القيمة الافتراضية (DefaultValue) بشكل صارم
            If fieldDict.exists("DefaultValue") Then
                On Error Resume Next
                fld.defaultValue = Null ' حذف القيمة الافتراضية الحالية إذا كانت موجودة
                On Error GoTo 0

                ' إضافة القيمة الافتراضية بناءً على نوع الحقل
                If Not IsNull(fieldDict("DefaultValue")) And Trim(Nz(fieldDict("DefaultValue"), "")) <> "" Then
                    Select Case fieldDict("Type")
                        Case dbText, dbMemo, dbAttachment
                            ' للحقول النصية، نقوم بتحويل القيمة إلى سلسلة
                            fld.defaultValue = CStr(fieldDict("DefaultValue"))
                        Case dbInteger, dbLong, dbBigInt, dbByte
                            ' للحقول العددية، نقوم بتحويل القيمة إلى رقم
                            fld.defaultValue = CStr(Nz(fieldDict("DefaultValue"), 0))
                        Case dbDate
                            ' للحقول التاريخية، نقوم بتحويل القيمة إلى تنسيق تاريخ
                            fld.defaultValue = Format(Nz(fieldDict("DefaultValue"), Now()), "yyyy-mm-dd hh:mm:ss")
                        Case Else
                            ' لأي نوع آخر، نقوم بتحويل القيمة إلى سلسلة
                            fld.defaultValue = CStr(fieldDict("DefaultValue"))
                    End Select
                Else
                    ' إذا كانت القيمة الافتراضية فارغة أو Null، نقوم بإزالة القيمة الحالية
                    fld.defaultValue = ""
                End If
            End If
        End If
    Next key
End Sub

' دالة لفحص ما إذا كان الجدول مفتوحًا وإغلاقه إذا لزم الأمر
Public Function CloseTableIfNecessary(tableName As String) As Boolean
    Dim db As DAO.Database
    Set db = CurrentDb

    ' حاول إغلاق الجدول إذا كان مفتوحًا
    On Error Resume Next
    ' إغلاق الجدول إذا كان مفتوحًا
    DoCmd.Close acTable, tableName
    If Err.Number = 0 Then
        ' إذا تم إغلاق الجدول بنجاح
        CloseTableIfNecessary = True
    Else
        ' إذا فشل في إغلاق الجدول
        CloseTableIfNecessary = False
    End If
    On Error GoTo 0
End Function

' هذا الإجراء يقوم بإنشاء الجدول أو تحديثه وإضافة البيانات إذا كانت موجودة
Public Sub CreateOrModifyTable(tableName As String, Fields As Object)
    Dim db As DAO.Database
    Dim tdf As DAO.TableDef

    Set db = CurrentDb()

    ' إذا لم يكن الجدول موجودًا، نقوم بإنشائه
    If Not IsTableExist(tableName) Then
        CreateNewTable tableName, Fields
    Else
        ' إذا كان الجدول موجودًا، نقوم بتحديث الحقول فيه
        Set tdf = db.TableDefs(tableName)
        EnsureFieldsExist tdf, Fields
    End If

    ' إضافة أو تحديث خصائص الحقول
    SetFieldProperties tableName, Fields
    ' تحديث نافذة قاعدة البيانات لتظهر التغييرات
    Application.RefreshDatabaseWindow
End Sub

' هذا الإجراء يقوم بإنشاء الجدول أو تحديثه بالإضافة إلى إضافة البيانات إذا كانت موجودة
Public Sub CreateOrModifyTableAndInsertData(tableName As String, _
                                         Fields As Object, _
                                         Optional fieldValues As Object, _
                                         Optional bAddData As Boolean = False)
    Dim db As DAO.Database
    Dim tdf As DAO.TableDef
    Dim rst As DAO.Recordset
    Dim key As Variant
    Dim fieldValue As Variant
    Dim fieldName As String

    Set db = CurrentDb()

    ' التأكد من إغلاق الجدول قبل التعديل
    If Not CloseTableIfNecessary(tableName) Then
        ' في حال كان الجدول مفتوحًا بواسطة مستخدم آخر، نعرض رسالة تحذير
        MsgBox "لا يمكن تعديل الجدول لأنه مفتوح بواسطة مستخدم آخر.", vbExclamation
        Exit Sub
    End If

    ' إنشاء الجدول أو تحديثه
    If Not IsTableExist(tableName) Then
        CreateNewTable tableName, Fields
    Else
        Set tdf = db.TableDefs(tableName)
        EnsureFieldsExist tdf, Fields
    End If

    ' إضافة خصائص الحقول
    SetFieldProperties tableName, Fields

    ' إضافة البيانات إذا كانت القيمة للعلم صحيحة
    If bAddData And Not (fieldValues Is Nothing) Then
        If fieldValues.Count > 0 Then
            ' فتح مجموعة السجلات للجدول المحدد
            Set rst = db.OpenRecordset(tableName, dbOpenDynaset)
            ' التحقق مما إذا كان الجدول فارغًا
            Dim isEmpty As Boolean
            isEmpty = (rst.RecordCount = 0)

            If isEmpty Then
                ' إذا كان الجدول فارغًا، نضيف سجل جديد
                rst.AddNew
                ' إضافة البيانات من القاموس إلى السجل الجديد
                For Each key In fieldValues.Keys
                    fieldName = key
                    fieldValue = fieldValues(key)
                    rst(fieldName) = fieldValue
                Next key
                rst.Update
            Else
                ' إذا كان الجدول غير فارغ، نقوم بتحديث السجلات الموجودة
                rst.MoveFirst
                For Each key In fieldValues.Keys
                    fieldName = key
                    fieldValue = fieldValues(key)
                    ' التحقق من وجود تغيير في قيمة الحقل قبل التحديث
                    If IsNull(rst(fieldName)) Or Nz(rst(fieldName), "") <> fieldValue Then
                        rst.Edit
                        rst(fieldName) = fieldValue
                        rst.Update
                    End If
                Next key
            End If
            rst.Close
        End If
    End If

    ' تحديث نافذة قاعدة البيانات بعد التعديل
    Application.RefreshDatabaseWindow
End Sub


الان الوحدة النمطية الثانويه والخاصة باستدعاء الداول اما لانشاء جدول/جداول فارغه بدون بيانات او انشاء جدول/جداول مع الحاق بيانات اساسية لحقل/حقول الجدول/الجداول
لنعطى مثلا للوحدة النمطية العامة الاسم : basTablesInitialization

' هذا الإجراء يقوم بتهيئة البيانات الخاصة بالتصميم (إنشاء الجدول وإضافة البيانات)
Public Sub InitializeDesignerTableWithData()
    Dim fieldValues As Object
    Dim tblName As String
    tblName = "UsysTblDesignerInformation" ' اسم الجدول الذي يحتوي على معلومات المصمم

    Set Fields = CreateDictionary() ' إنشاء القاموس لاحتواء الحقول
    Set fieldValues = CreateDictionary() ' إنشاء القاموس لاحتواء القيم المرتبطة بالحقول

    ' إضافة الحقول ومعلومات كل حقل:
    ' (اسم الحقل - نوع الحقل - حجم الحقل - التنسيق - القيمة الافتراضية - التسمية - الوصف)
    AddFieldToDictionary "ID", dbAutoNumber, , , , "المعرف", "حقل :المعرف (التلقائي)"
    AddFieldToDictionary "DesignerPlatform", dbText, 100, "@[red]", "Officena", "المنصة", "حقل : يحتوى على رابط المنصة"
    AddFieldToDictionary "FullName", dbText, , , , "الاسم", "حقل : يحتوى على اسم المبرمج"
    AddFieldToDictionary "Email", dbText, , , , "البريد الإلكتروني", "حقل : يحتوى على البريد الإلكتروني للمبرمج"
    AddFieldToDictionary "PhoneNumber", dbText, , , , "رقم الهاتف", "حقل : يحتوى على رقم الهاتف للمبرمج"
    AddFieldToDictionary "DesignSpecialty", dbText, , , , "مجال التخصص", "حقل : يحتوى على مجال التخصص (التخصص الفني أو المهني للمصمم - تصميم واجهات المستخدم (UI) - تصميم تجربة المستخدم (UX) - تطوير البرمجيات الخلفية (Back-End) )"
    AddFieldToDictionary "PortfolioLink", dbText, , , , "سابقة الأعمال", "حقل : يحتوى على رابط لمعرض سابقة الأعمال للمبرمج - موقع المبومج"
    AddFieldToDictionary "CreationDate", dbDate, , "dddd, mmmm dd, yyyy hh:nn:ss AM/PM", "Now()", "تاريخ إنشاء السجل", "حقل : يحتوى على تاريخ إنشاء السجل الحالى"


    ' إضافة القيم الخاصة بكل حقل
    fieldValues("DesignerPlatform") = "Example Designer Platform™"
    fieldValues("FullName") = "Example Designer Name"
    fieldValues("Email") = "example.designer@email.com"
    fieldValues("PhoneNumber") = "+000 Example Designer Phone Number"
    fieldValues("DesignSpecialty") = "Example Designer Specialty"
    fieldValues("PortfolioLink") = "https://example.com/designer-portfolio"
    fieldValues("CreationDate") = Now ' تعيين تاريخ السجل الحالي

    ' التأكد من إغلاق الجدول قبل التعديل
    If Not CloseTableIfNecessary(tblName) Then Exit Sub ' إغلاق الجدول إذا كان مفتوحًا من قبل

    ' إنشاء الجدول أو تحديثه، بالإضافة إلى إضافة البيانات إذا كانت القيم موجودة
    CreateOrModifyTableAndInsertData tblName, Fields, fieldValues, True
End Sub

' هذا الإجراء يقوم بتهيئة الجدول فقط بدون إضافة البيانات الخاصة بالتصميم
Public Sub InitializeDesignerTableStructure()
    Dim tblName As String
    tblName = "UsysTblDesignerInformation" ' اسم الجدول الذي يحتوي على معلومات المصمم

    Set Fields = CreateDictionary() ' إنشاء القاموس لاحتواء الحقول

    ' إضافة الحقول ومعلومات كل حقل:
    ' (اسم الحقل - نوع الحقل - حجم الحقل - التنسيق - القيمة الافتراضية - التسمية - الوصف)
    AddFieldToDictionary "ID", dbAutoNumber, , , , "المعرف", "حقل :المعرف (التلقائي)"
    AddFieldToDictionary "DesignerPlatform", dbText, 100, "@[red]", "Officena", "المنصة", "حقل : يحتوى على رابط المنصة"
    AddFieldToDictionary "FullName", dbText, , , , "الاسم", "حقل : يحتوى على اسم المبرمج"
    AddFieldToDictionary "Email", dbText, , , , "البريد الإلكتروني", "حقل : يحتوى على البريد الإلكتروني للمبرمج"
    AddFieldToDictionary "PhoneNumber", dbText, , , , "رقم الهاتف", "حقل : يحتوى على رقم الهاتف للمبرمج"
    AddFieldToDictionary "DesignSpecialty", dbText, , , , "مجال التخصص", "حقل : يحتوى على مجال التخصص (التخصص الفني أو المهني للمصمم - تصميم واجهات المستخدم (UI) - تصميم تجربة المستخدم (UX) - تطوير البرمجيات الخلفية (Back-End) )"
    AddFieldToDictionary "PortfolioLink", dbText, , , , "سابقة الأعمال", "حقل : يحتوى على رابط لمعرض سابقة الأعمال للمبرمج - موقع المبومج"
    AddFieldToDictionary "CreationDate", dbDate, , "dddd, mmmm dd, yyyy hh:nn:ss AM/PM", "Now()", "تاريخ إنشاء السجل", "حقل : يحتوى على تاريخ إنشاء السجل الحالى"
    
    ' التأكد من إغلاق الجدول قبل التعديل
    If Not CloseTableIfNecessary(tblName) Then Exit Sub ' إغلاق الجدول إذا كان مفتوحًا من قبل
    
    ' إنشاء الجدول أو تحديثه فقط بدون إضافة البيانات
    CreateOrModifyTableAndInsertData tblName, Fields, , False ' لا يتم إضافة بيانات هذه المرة
End Sub

 

بشكل عام حنى تتضح الرؤيه بشكل مفصل

الفكرة هنا هى كتابة دوال لانشاء الجداول الاساسية للتطبيق والتى لا يريد المبرمج لاى احد العبث بها سواء كان فى :
اسم الجدول - اسم الحقل -  نوع الحقل :خصائص الحقل ( الحجم - التنسيق - القيمه الافتراضيه - التسميه " عنوان الحقل"  -  الوصف : الذى يظهر دخل الجدول عند وضع التصميم )

حيث يهدف هذا الكود إلى توفير حل برمجي متكامل لإنشاء جداول قواعد البيانات وتحديثها تلقائيًا بناءً على مواصفات الحقول المحددة في قاموس ديناميكي .
مما يتيح الكود للمطورين إدارة هيكل الجدول (Structure) وخصائص الحقول (Properties) مثل الاسم، النوع، الحجم، التنسيق (Format)، القيمة الافتراضية (DefaultValue)، العنوان (Caption)، الوصف (Description)، بطريقة آلية ودقيقة

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

وبعيدا عن استدعاء الدوال التى تنشئ جداول مع اضافة البيانات

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

 

مثال سريع:

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

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

اخيرا اضع مرفقا بين اياديكم للتجربة والاستمتاع 
 

انشاء الجداول الاساسية وملئ البيانات V 3.0.2.accdb

  • Thanks 1
قام بنشر

ما شاء الله ، تبارك الرحمن :clapping:

سلمت يمناك لهذا الطرح الممتع ,,

وجزاك الله كل الخير على مجهودك الجميل والكبير حتى تصل لهذه النتيجة .:fff:.

 

اسمح لي بسؤال خطر على بالي :-

بما أن الكود يعتمد على مكتبة DAO ؛ هل سيدعم الإصدارات القديمة التي لا تدعم هذه المكتبة !!!

  • Haha 1
قام بنشر
21 دقائق مضت, Foksh said:

وجزاك الله كل الخير على مجهودك الجميل والكبير حتى تصل لهذه النتيجة .:fff:.

جزانا الله واياكم خير الجزاء

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

اسمح لي بسؤال خطر على بالي :-

بما أن الكود يعتمد على مكتبة DAO ؛ هل سيدعم الإصدارات القديمة التي لا تدعم هذه المكتبة !!!

لازم سؤال لولبى ...  ليه الإحراج ده  :frown3:

شوف يا سيدى 
انا لم استخدم المكتبه المدمجه باضافتها كـ  References فى القاعده 
بناء على ذلك لم اقم بتعريف المتغيرات بهذا الشكل Dim db As Databaseوالذى يعتمد على المكتبه السابقة فى الاصدارات القديمه

بل قمت بتعريف المتغيرات بالشكل التالى Dim db As DAO.Database
وهذا يقلل من احتمالية الأخطاء إذا كانت المكتبة مفقودة

اعرف ان الاصدرات الحديثه بدأ من 2013 وما بعده تستخدم DAO المدمج مع محرك ACE (Access Connectivity Engine) وتستبدل محرك Jet القديم

حاولت جاهد وكذلك فى موضوع انشاء هيكل المجلدات ان لا اعتمد على المكتبات الداخليه بشكل صريح 
حاولت استخدام  Late Binding بدلا من استخدام Early Binding حيث لا يتم ربط الكائنات بالمكتبة حتى وقت التشغيل

ولكن بصراحة الامر يستوجب التجربه للتأكد 
 

قام بنشر
3 ساعات مضت, ابو جودي said:

انا لم استخدم المكتبه المدمجه باضافتها كـ  References فى القاعده 

دي واضحة من الكود ، وفكرة جميلة انك تستغنى عن المكتبات ..

 

3 ساعات مضت, ابو جودي said:

اعرف ان الاصدرات الحديثه بدأ من 2013 وما بعده تستخدم DAO المدمج مع محرك ACE (Access Connectivity Engine) وتستبدل محرك Jet القديم

كلام سليم :yes: 

3 ساعات مضت, ابو جودي said:

ولكن بصراحة الامر يستوجب التجربه للتأكد 

لازم نجرب من خلال الإخوة الذين لديهم إصدارات أقل أو توافق 2007 :smile: 

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

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

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information