ابو جودي

اتفضل 1.accdb

جزانا الله واياكم خير الجزاء لازم سؤال لولبى ... ليه الإحراج ده شوف يا سيدى انا لم استخدم المكتبه المدمجه باضافتها كـ References فى القاعده بناء على ذلك لم اقم بتعريف المتغيرات بهذا الشكل : Dim db As Databaseوالذى يعتمد على المكتبه السابقة فى الاصدارات القديمه بل قمت بتعريف المتغيرات بالشكل التالى : Dim db As DAO.Database وهذا يقلل من احتمالية الأخطاء إذا كانت المكتبة مفقودة اعرف ان الاصدرات الحديثه بدأ من 2013 وما بعده تستخدم DAO المدمج مع محرك ACE (Access Connectivity Engine) وتستبدل محرك Jet القديم حاولت جاهد وكذلك فى موضوع انشاء هيكل المجلدات ان لا اعتمد على المكتبات الداخليه بشكل صريح حاولت استخدام Late Binding بدلا من استخدام Early Binding حيث لا يتم ربط الكائنات بالمكتبة حتى وقت التشغيل ولكن بصراحة الامر يستوجب التجربه للتأكد

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

والان مع الاصدار الجديد ـــــــــــــــــــــــــــــــــــــــــ اولا الاكواد داخل الوحده النمطيه العامة طبعا افضل كتابه الكود ومشاركته تحسبا لوجود اى مشاكل فى المرفقات او التحميل لنعطى مثلا للوحدة النمطية العامة الاسم : 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

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

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

UPDATE [ارقام مسلسله] SET [مسلسل] = IIf( InStr([مسلسل], "/2024") > 0, Left([مسلسل], Len([مسلسل]) - 5) & "/" & Year(Date()), [مسلسل] ) ولكن هذا افضل ليه إذا كان الحقل "مسلسل" يحتوي على أكثر من شريط مائل / في النص فإن : InStr([مسلسل], "/") سوف يعيد موضع أول شريط مائل فقط في هذه الحالة سيتغير الجزء الأيسر ولكن لن يتم استبدال السنة بشكل صحيح إذا كان هناك شرطة مائلة آخري الصح وانت تضع حل مشكله توقع الاخطاء التى قد تصادفها وتسبب خطأ فى حل المشكله

السلام عليكم ورحمة الله تعالى وبركاته استكمالا لسلسلة الافكار المطروحة للنقاش والتى اتمنى ان اجد فيها تفاعلا بالنقاش وابداء الرأى اليوم اقدم لكم التالى الكود يهدف إلى إدارة الحقول والجداول في قاعدة بيانات يتضمن الكود مجموعة من الإجراءات التي تمكن المستخدم من: إنشاء الجداول و الحقول في الجداول وتحديث خصائص الحقول مثل التسمية والوصف ويمكن إضافة البيانات إلى الجداول بشكل اختياري الى الحقول كذلك اذا استدعت الحاجة الى ذلك كما يتيح الكود إضافة الحقول إلى الجداول إذا كانت غير موجودة أو تحديث البيانات داخل الحقول فى الجداول إذا كانت موجودة يتم أيضًا دعم الحقول المتعددة الخيارات (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 وكما ذكرت الموضوع مطروح للتجربة والنقاش .... اتمنى وارجوا من حضراتكم التفاعل بالنقاش وابداء الرأى

نعم ولكن طبعا يلزم صلاحيات لذلك فى وجود الصلاحيات كل شئ تمام

السلام عليكم ورحمة الله تعالى وبركاته الموضوع بخصوص انشاء مجلدات الموضوع مطروح للتجربه والنقاش بفكره جديده تشمل كل الاحتمالات تقريبا التى خطرت على بالى الاكواد فى وحدة نمطيه عامة كالاتى ' استيراد كائن FileSystemObject Private fso As Object ' تهيئة كائن FileSystemObject Private Sub InitializeFSO() If fso Is Nothing Then Set fso = CreateObject("Scripting.FileSystemObject") End If End Sub ' فحص وجود مجلد باستخدام FileSystemObject Private Function FolderExists(path As String) As Boolean InitializeFSO FolderExists = fso.FolderExists(path) End Function ' إنشاء بنية مجلدات متدرجة Private Function CreateFolderStructure(fullPath As String, ByRef errorMessage As String) As Boolean On Error GoTo ErrorHandler Dim parts() As String Dim currentPath As String Dim i As Integer ' تقطيع المسار إلى أجزاء parts = Split(fullPath, "\") currentPath = "" ' إنشاء كل جزء من المسار بشكل متدرج For i = LBound(parts) To UBound(parts) If parts(i) <> "" Then currentPath = currentPath & parts(i) & "\" If Not FolderExists(currentPath) Then fso.CreateFolder currentPath End If End If Next CreateFolderStructure = True Exit Function ErrorHandler: ' تخزين رسالة الخطأ في حال حدوث مشكلة errorMessage = "تعذر إنشاء المجلد: " & fullPath & " - الخطأ: " & Err.Description CreateFolderStructure = False End Function ' بناء مسار كامل من المسار الأساسي والمسار الفرعي Private Function BuildPath(basePath As String, subPath As String) As String ' التأكد من انتهاء المسار الأساسي بشرطة ميل (/) If Right(basePath, 1) <> "\" Then basePath = basePath & "\" ' استبدال شرط الميل ("/") بشريط الميل ("\") BuildPath = basePath & Replace(subPath, "/", "\") End Function ' تنظيف المسار وإصلاح الأخطاء الشائعة Function BuildFullPath(rawPath As String) As String Dim cleanPath As String ' إزالة الفراغات الزائدة واستبدال الرموز غير الصحيحة cleanPath = Trim(rawPath) cleanPath = Replace(cleanPath, "/", "\") ' تصحيح الأخطاء في بداية المسار (C\Test ? C:\Test) If Len(cleanPath) >= 2 And Mid(cleanPath, 2, 1) = "\" And (Asc(UCase(Left(cleanPath, 1))) >= 65 And Asc(UCase(Left(cleanPath, 1))) <= 90) Then cleanPath = Left(cleanPath, 1) & ":\" & Mid(cleanPath, 3) End If ' التحقق مما إذا كان المسار يبدأ بحرف قرص (مثل C:) لكنه لا يحتوي على \ بعده، وإصلاحه If Len(cleanPath) >= 2 And Mid(cleanPath, 2, 1) = ":" And Mid(cleanPath, 3, 1) <> "\" Then cleanPath = Left(cleanPath, 2) & "\" & Mid(cleanPath, 3) End If If Len(cleanPath) >= 2 And Mid(cleanPath, 2, 1) = "\" Then cleanPath = Left(cleanPath, 1) & ":\" & Right(cleanPath, Len(cleanPath) - 2) End If ' إذا لم يحتوي المسار على رمز قرص أو مسار شبكة، يتم ربطه بمسار المشروع الحالي If InStr(cleanPath, ":") = 0 And Left(cleanPath, 2) <> "\\" Then cleanPath = CurrentProject.path & "\" & cleanPath If Left(cleanPath, 1) = ":" Then cleanPath = CurrentProject.path & "\" & cleanPath ' تصحيح الأخطاء في كتابة المسارات cleanPath = Replace(cleanPath, "\:\", "\\") cleanPath = Replace(cleanPath, "\::\", "\") cleanPath = Replace(cleanPath, "\:", "\") ' استبدال \\ بـ \ باستثناء مسارات الشبكة \\Server\Share If Left(cleanPath, 2) <> "\\" Then cleanPath = Replace(cleanPath, "\\", "\") ' إرجاع المسار النظيف BuildFullPath = cleanPath End Function ' إنشاء مجلدات بناءً على قائمة مسارات فرعية Public Function CreateFolders(basePath As String, ParamArray folderPaths() As Variant) As String On Error GoTo ErrorHandler Dim path As Variant Dim fullPath As String Dim errorMessage As String InitializeFSO ' التحقق من وجود المسار الأساسي وإنشاؤه إذا لم يكن موجودًا If Not FolderExists(basePath) Then CreateFolderStructure basePath, errorMessage If errorMessage <> "" Then CreateFolders = errorMessage Exit Function End If End If ' إنشاء المسارات الفرعية For Each path In folderPaths fullPath = BuildPath(basePath, CStr(path)) If Not CreateFolderStructure(fullPath, errorMessage) Then CreateFolders = errorMessage Exit Function End If Next CreateFolders = "Success" Exit Function ErrorHandler: CreateFolders = "خطأ " & Err.Number & ": " & Err.Description End Function ' إنشاء مجلدات بناءً على بيانات جدول في قاعدة البيانات Public Function CreateFoldersFromTable(tableName As String, basePathField As String, Optional condition As String = "") As String On Error GoTo ErrorHandler Dim db As DAO.Database Dim rs As DAO.Recordset Dim query As String Dim basePath As String Dim folderPath As String Dim errorMessage As String Set db = CurrentDb() ' بناء استعلام لاستخراج المسارات الفريدة query = "SELECT DISTINCT [" & basePathField & "] FROM [" & tableName & "]" If condition <> "" Then query = query & " WHERE " & condition Set rs = db.OpenRecordset(query, dbOpenSnapshot) ' التحقق من وجود سجلات If rs.BOF And rs.EOF Then CreateFoldersFromTable = "لا توجد سجلات." Exit Function End If ' إنشاء المجلدات لكل سجل Do While Not rs.EOF basePath = Nz(rs.Fields(basePathField).Value, "") folderPath = BuildFullPath(basePath) ' التحقق من صحة المسار وإنشاؤه If Not CreateFolderStructure(folderPath, errorMessage) Then CreateFoldersFromTable = errorMessage Exit Function End If rs.MoveNext Loop ' إغلاق السجلات وتنظيف الذاكرة rs.Close Set rs = Nothing Set db = Nothing CreateFoldersFromTable = "Success" Exit Function ErrorHandler: CreateFoldersFromTable = "خطأ " & Err.Number & ": " & Err.Description End Function ويتم الاستدعاء حسب خيال المبرمج وهذه امثله لصور الاستدعاء ' إنشاء مجلدات يدويا ً من خلال تمرير المسار Sub Example1() Dim result As String result = CreateFolders("C:\Project Resources", _ "Backup", _ "Fonts\Arabic", _ "Fonts\English", _ "Images\Ico", _ "Images\Logo", _ "Images\QR Code", _ "PDF", _ "Utility\Reference\MsAccess", _ "Utility\Reference\TBL") If result = "Success" Then MsgBox "تم إنشاء المجلدات بنجاح!", vbInformation Else MsgBox "فشل في إنشاء المجلدات: " & result, vbCritical End If End Sub ' إنشاء مجلدات داخل مشروع Access الحالي Sub Example2() Dim result As String result = CreateFolders(CurrentProject.path & "\Project Resources", _ "Backup", _ "Fonts\Arabic", _ "Fonts\English", _ "Images\Ico", _ "Images\Logo", _ "Images\QR Code", _ "PDF", _ "Utility\Reference\MsAccess", _ "Utility\Reference\TBL") If result = "Success" Then MsgBox "تم إنشاء المجلدات داخل مشروع Access!", vbInformation Else MsgBox "حدث خطأ أثناء إنشاء المجلدات: " & result, vbCritical End If End Sub ' إنشاء مجلدات من جدول في قاعدة البيانات Sub Example3() Dim result As String result = CreateFoldersFromTable("tblFolderPaths", "FolderPath") If result = "Success" Then MsgBox "تم إنشاء المجلدات بنجاح!", vbInformation Else MsgBox "فشل في إنشاء المجلدات: " & result, vbCritical End If End Sub ' إنشاء مجلدات بناءً على فئة معينة Sub Example4() Dim result As String result = CreateFoldersFromTable("tblFolderPaths", "FolderPath", "Category = 'Access'") If result = "Success" Then MsgBox "تم إنشاء المجلدات الخاصة بمكتبات Access!", vbInformation Else MsgBox "فشل في إنشاء المجلدات: " & result, vbCritical End If End Sub ' إنشاء مجلدات شبكة (UNC Paths) Sub Example5() Dim result As String result = CreateFoldersFromTable("tblNetworkPaths", "UNCPath") If result = "Success" Then MsgBox "تم إنشاء المجلدات الشبكية بنجاح!", vbInformation Else MsgBox "حدث خطأ أثناء إنشاء المجلدات الشبكية: " & result, vbCritical End If End Sub ' إنشاء مجلدات شبكة بناءً على خادم معين Sub Example6() Dim result As String result = CreateFoldersFromTable("tblNetworkPaths", "UNCPath", "Server = 'FileServer01'") If result = "Success" Then MsgBox "تم إنشاء المجلدات على FileServer01!", vbInformation Else MsgBox "فشل في العثور على مجلدات لهذا الخادم: " & result, vbCritical End If End Sub ' إنشاء مجلدات بناءً على مدخلات المستخدم Sub Example7() Dim userCategory As String userCategory = InputBox("أدخل اسم الفئة لإنشاء المجلدات:", "تحديد الفئة") If userCategory <> "" Then Dim result As String result = CreateFoldersFromTable("tblFolderPaths", "FolderPath", "Category = '" & userCategory & "'") If result = "Success" Then MsgBox "تم إنشاء المجلدات للفئة: " & userCategory, vbInformation Else MsgBox "فشل في إنشاء المجلدات: " & result, vbCritical End If Else MsgBox "لم يتم إدخال فئة صحيحة!", vbExclamation End If End Sub الهدف: إنشاء مجلدات ديناميكيًا في مسار أساسي باستخدام معلومات مدخلة يدوية أو مستخلصة من قاعدة بيانات الحالات المختلفة للاستدعاء: الحالة 1: استدعاء دالة لإنشاء مجلد /هيكل المجلدات يدويا ً من خلال تمرير المسار الحالة 2: استدعاء دالة لإنشاء مجلد /هيكل المجلدات في مجلد مشروع Access الحالي الحالة 3: استدعاء دالة لإنشاء مجلد /هيكل المجلدات من خلال مسارات من جدول قاعدة بيانات الحالة 4: استدعاء دالة لإنشاء مجلد /هيكل المجلدات من خلال مسارات من جدول مع تصفية حسب فئة معينة الحالة 5: استدعاء دالة لإنشاء مجلد /هيكل المجلدات يدويا ً من خلال تمرير المسار الشبكي(UNC) الحالة 6: استدعاء دالة لإنشاء المجلدات من خلال مسارات من جدول مع تصفية حسب اسم الخادم المستخدم للمسار الشبكي (UNC) انشاء مجلد او هيكل مجلدات.zip

واو الموضوع كبـــــــر يسعدنى ان اشارك عظماء المنتدى واساتذتى الأجلاء فى هذه الافكار ولا اخفيكم انه وسام شرف ان يذكر اسم العبد الفقير طويلب العلم بجوار اساتذة واعمدة المنتدى طيب وما رأيكم استاذ @jjafferr و استاذ @AbuuAhmed فى الكود التالى Dim t As Double, currentID As Long t = Timer With Me If .Dirty Then .Dirty = False currentID = !ID End With Dim db As DAO.Database Set db = CurrentDb db.Execute "UPDATE employees SET y_n = False WHERE y_n = True;", dbFailOnError db.Execute "UPDATE employees SET y_n = True WHERE ID = " & currentID & ";", dbFailOnError With Me .Requery If .Recordset.RecordCount > 0 Then .Recordset.FindFirst "ID = " & currentID End If End With Debug.Print "الوقت المستغرق: " & Timer - t & " ثانية"

طيب وممكن رايكم بالكود التالى Private Sub y_n_Click() On Error GoTo ErrorHandler Dim sql As String Dim currentID As Variant ' حفظ السجل الحالي If Me.Dirty Then Me.Dirty = False End If ' الحصول على معرف السجل الحالي currentID = Me!id ' تحديث كافة السجلات لإلغاء التحديد sql = "UPDATE a SET y_n = False" CurrentDb.Execute sql, dbFailOnError ' تعيين السجل الحالي فقط sql = "UPDATE a SET y_n = True WHERE ID = " & currentID CurrentDb.Execute sql, dbFailOnError ' تحديث النموذج لإظهار التغييرات Me.Requery ' العودة إلى السجل الحالي Me.Recordset.FindFirst "ID = " & currentID Exit Sub ErrorHandler: MsgBox "حدث خطأ: " & Err.Description, vbExclamation, "Error" Debug.Print "حدث خطأ: " & Err.Number & "|" & Err.Description Exit Sub End Sub HH.accdb

اتفضل ss (2Saad-1).zip

ابدا فى وضع التحليل المناسب والتصور الامثل لاحتياجات وابدأ فى انشاء قاعدة البيانات وفقا لذلك ان تعثرت فى تنفيذ اى شئ ارجع الى الموضوع واسال وان شاء الله تجد الدعم المناسب ودعنى اضع لك اللبنة الاولى بشكل عام ولكن قد تكون مخالفة لمتطلباتك او رغباتك او الية العمل لذلك خذ فكرة مما اعرضه عليه فذلك سوف يفتح لك افاق التصور والتخيل الصحيح ليضعك على البداية الصحيحة للمسار الامثل لانشاء قاعدة بياناتك 1. الجداول (Tables) أ. جدول الكتب (Books) الحقول: BookID: مفتاح أساسي (رقمي تلقائي). Title: عنوان الكتاب (نصي). Author: اسم المؤلف (نصي). ISBN: رقم ISBN (نصي، فريد). Publisher: الناشر (نصي). PublicationYear: سنة النشر (تاريخ). GenreID: مفتاح خارجي (يرتبط بجدول التصنيفات). Language: اللغة (نصي). TotalCopies: عدد النسخ الإجمالي (رقمي). AvailableCopies: عدد النسخ المتاحة (رقمي). ShelfLocation: موقع الكتاب على الرف (نصي). ملاحظات إضافية: إذا كان لديك مؤلفون متعددون لنفس الكتاب، يمكن فصل المؤلفين إلى جدول مستقل (Authors) مع جدول وسيط (BookAuthors). إضافة حقل مثل BookDescription لتقديم وصف موجز عن الكتاب قد يكون مفيدًا. ب. جدول الأعضاء (Members) الحقول: MemberID: مفتاح أساسي (رقمي تلقائي). FirstName: الاسم الأول (نصي). LastName: الاسم الأخير (نصي). Email: البريد الإلكتروني (نصي، فريد). Phone: رقم الهاتف (نصي). Address: العنوان (نصي). MembershipDate: تاريخ الانضمام (تاريخ). Status: حالة العضوية (نشيط/غير نشيط، نصي أو منطقي). ملاحظات إضافية: يمكن إضافة حقل MembershipType لتحديد نوع العضوية (مثل عادية أو مميزة). حقل Notes قد يكون مفيدًا لتسجيل أي ملاحظات إضافية. ج. جدول الإعارات (Borrowings) الحقول: BorrowID: مفتاح أساسي (رقمي تلقائي). MemberID: مفتاح خارجي يرتبط بجدول الأعضاء. BookID: مفتاح خارجي يرتبط بجدول الكتب. BorrowDate: تاريخ الإعارة (تاريخ). DueDate: تاريخ الاستحقاق (تاريخ). ReturnDate: تاريخ الإرجاع (تاريخ). Status: حالة الإعارة (معارة/مرجعة/متأخرة). ملاحظات إضافية: يمكن إضافة حقل FineAmount لتسجيل الغرامة عند تأخر الإرجاع. د. جدول التصنيفات (Genres) الحقول: GenreID: مفتاح أساسي (رقمي تلقائي). GenreName: اسم التصنيف (نصي). 2. العلاقات بين الجداول (Relationships) العلاقات: Books.GenreID ↔ Genres.GenreID: علاقة واحد إلى متعدد. Borrowings.MemberID ↔ Members.MemberID: علاقة واحد إلى متعدد. Borrowings.BookID ↔ Books.BookID: علاقة واحد إلى متعدد. ملاحظات: تأكد من تعريف العلاقات في Access وربط الجداول بمفاتيحها الأساسية. قم بتمكين التكامل المرجعي (Referential Integrity) لتجنب إدخال بيانات غير متطابقة. 3. تحسينات إضافية جدول المؤلفين (Authors)اختياري: AuthorID: مفتاح أساسي. AuthorName: اسم المؤلف. ثم إنشاء جدول وسيط BookAuthors: BookID: مفتاح خارجي من جدول الكتب. AuthorID: مفتاح خارجي من جدول المؤلفين. جدول الغرامات (Fines): FineID: مفتاح أساسي. BorrowID: مفتاح خارجي من جدول الإعارات. FineAmount: مبلغ الغرامة. واجهة المستخدم (Forms): إنشاء واجهات سهلة الاستخدام لإضافة الكتب، إدارة الأعضاء، وتتبع الإعارات. إضافة تقارير لإحصائيات المكتبة (مثل الكتب الأكثر استعارة). الاستعلامات (Queries): استعلام لتحديد الكتب المتأخرة عن الإرجاع. استعلام لتقرير الأعضاء النشطين.

مش عارف انا عارف افهمك واللا لاء جرب استخدام الاكواد التاليه Sub DuplicateRecords() Dim db As DAO.Database Dim rs As DAO.Recordset Dim newPCode As Long Dim todayDate As Date Dim sqlInsertLab As String Dim sqlInsertRequest As String Dim sqlInsertTests As String ' فتح قاعدة البيانات الحالية Set db = CurrentDb() todayDate = Date ' جلب آخر PCode من جدول tbl_NewLab لتجنب التكرار Set rs = db.OpenRecordset("SELECT MAX(PCode) AS MaxPCode FROM tbl_NewLab") If Not rs.EOF Then newPCode = rs!MaxPCode + 1 Else newPCode = 1 ' في حالة عدم وجود سجلات End If rs.Close ' استبدال المرجع بالصيغة الصحيحة Dim currentPCode As Long currentPCode = Forms!New_Project!newRequest.Form!PCode ' إدراج السجل الجديد في tbl_NewLab sqlInsertLab = "INSERT INTO tbl_NewLab (DDate, PCode, Pname, Name_Month, C_Year, Area, Code_Month, Mon_Year) " & _ "SELECT #" & todayDate & "#, " & newPCode & ", Pname, Name_Month, C_Year, Area, Code_Month, Mon_Year " & _ "FROM tbl_NewLab WHERE PCode = " & currentPCode db.Execute sqlInsertLab ' إدراج السجل الجديد في tbl_NewRequest sqlInsertRequest = "INSERT INTO tbl_NewRequest (PCode, TCode, Date_R, Price_R, Tname_R) " & _ "SELECT " & newPCode & ", TCode, #" & todayDate & "#, Price_R, Tname_R " & _ "FROM tbl_NewRequest WHERE PCode = " & currentPCode db.Execute sqlInsertRequest ' إدراج السجل الجديد في tbl_NewTests (إذا لزم الأمر) sqlInsertTests = "INSERT INTO tbl_NewTests (TCode, TName, Price) " & _ "SELECT TCode, TName, Price " & _ "FROM tbl_NewTests WHERE TCode IN (SELECT TCode FROM tbl_NewRequest WHERE PCode = " & currentPCode & ")" db.Execute sqlInsertTests MsgBox "تم تكرار السجل بنجاح مع تحديث PCode والتاريخ.", vbInformation End Sub Private Sub أمر4030_Click() DuplicateRecords End Sub