M.Abd Allah

جربي الكود ده إن شاء الله هيظبط معاكي On Error GoTo ErrorHandler Dim db As DAO.Database Dim rs As DAO.Recordset Dim fixedNameValue As String Dim newResultValue As String Dim fixedDefaultValue As Variant Dim fixedNormalValue As Variant Dim reportNameValue As Variant Dim sql As String Dim MAXCODE As Long ' الحصول على القيم من الحقول fixedNameValue = Me.testnameN newResultValue = Me.Newresult fixedDefaultValue = Me.fixeddefault fixedNormalValue = Me.fixednormal reportNameValue = Me.Reportname ' التحقق من أن الحقول الثلاثة ليست فارغة If IsNull(fixedDefaultValue) Or IsNull(fixedNormalValue) Or IsNull(reportNameValue) Then MsgBox "يرجى استكمال باقي البيانات (fixeddefault, fixednormal, Reportname) قبل الإضافة.", vbExclamation Exit Sub End If ' التحقق من أن القيم ليست فارغة If IsNull(fixedNameValue) Or IsNull(newResultValue) Then MsgBox "يرجى ملء جميع الحقول قبل الإضافة ثم الضغط على الزرار", vbExclamation Exit Sub End If ' فتح قاعدة البيانات Set db = CurrentDb ' التحقق من عدم تكرار السجل في fixedresults_tbl sql = "SELECT COUNT(*) AS RecordCount FROM fixedresults_tbl WHERE Fixedname = '" & fixedNameValue & "' AND Fixedresult = '" & newResultValue & "'" Set rs = db.OpenRecordset(sql) If Not rs.EOF And rs!RecordCount > 0 Then MsgBox "القيمة المدخلة موجودة مسبقاً.", vbExclamation rs.Close Set rs = Nothing Set db = Nothing Exit Sub End If rs.Close Set rs = Nothing ' الحصول على قيمة الكود الجديدة MAXCODE = Nz(DMax("code", "fixedresults_tbl"), 0) Me.code.Value = MAXCODE + 1 ' إضافة السجل الجديد في fixedresults_tbl sql = "INSERT INTO fixedresults_tbl (code, Fixedname, Fixedresult) " & _ "VALUES (" & Me.code.Value & ", '" & fixedNameValue & "', '" & newResultValue & "')" db.Execute sql, dbFailOnError ' تحديث القائمة Resultlist.Requery Newresult.Value = "" ' فتح الجدول Fixed_tbl للتحقق من وجود السجل وتحديثه أو إضافته sql = "SELECT * FROM Fixed_tbl WHERE fixedname = '" & fixedNameValue & "'" Set rs = db.OpenRecordset(sql) If rs.EOF Then rs.AddNew rs!fixedname = fixedNameValue Else rs.Edit End If rs!fixeddefault = fixedDefaultValue rs!fixednormal = fixedNormalValue rs!Reportname = reportNameValue rs.Update rs.Close Set rs = Nothing Set db = Nothing MsgBox "تمت الإضافة بنجاح!", vbInformation Exit Sub ErrorHandler: MsgBox "حدث خطأ: " & Err.Description, vbCritical If Not rs Is Nothing Then rs.Close Set rs = Nothing End If If Not db Is Nothing Then Set db = Nothing End If

طبقا للميكس اللي عملتيه جربي تعديل الكود ده On Error GoTo ErrorHandler Dim db As DAO.Database Dim rs As DAO.Recordset Dim fixedNameValue As String Dim newResultValue As String Dim fixedDefaultValue As Variant Dim fixedNormalValue As Variant Dim reportNameValue As Variant Dim sql As String Dim MAXCODE As Long ' الحصول على القيم من الحقول fixedNameValue = Me.testnameN newResultValue = Me.Newresult fixedDefaultValue = Me.fixeddefault fixedNormalValue = Me.fixednormal reportNameValue = Me.Reportname ' التحقق من أن الحقول الثلاثة ليست فارغة If IsNull(fixedDefaultValue) Or IsNull(fixedNormalValue) Or IsNull(reportNameValue) Then MsgBox "يرجى استكمال باقي البيانات (fixeddefault, fixednormal, Reportname) قبل الإضافة.", vbExclamation Exit Sub End If ' التحقق من أن القيم ليست فارغة If IsNull(fixedNameValue) Or IsNull(newResultValue) Then MsgBox "يرجى ملء جميع الحقول قبل الإضافة ثم الضغط على الزرار", vbExclamation Exit Sub End If ' فتح قاعدة البيانات Set db = CurrentDb ' التحقق من عدم تكرار السجل sql = "SELECT COUNT(*) AS RecordCount FROM fixedresults_tbl WHERE Fixedname = '" & fixedNameValue & "' AND Fixedresult = '" & newResultValue & "'" Set rs = db.OpenRecordset(sql) If Not rs.EOF And rs!RecordCount > 0 Then MsgBox "القيمة المدخلة موجودة مسبقاً.", vbExclamation rs.Close Set rs = Nothing Set db = Nothing Exit Sub End If rs.Close Set rs = Nothing ' الحصول على قيمة الكود الجديدة MAXCODE = Nz(DMax("code", "fixedresults_tbl"), 0) Me.code.Value = MAXCODE + 1 ' إضافة السجل الجديد في fixedresults_tbl sql = "INSERT INTO fixedresults_tbl (code, Fixedname, Fixedresult) " & _ "VALUES (" & Me.code.Value & ", '" & fixedNameValue & "', '" & newResultValue & "')" db.Execute sql, dbFailOnError ' تحديث القائمة Resultlist.Requery Newresult.Value = "" ' إبلاغ المستخدم بالنجاح MsgBox "تمت الإضافة بنجاح!", vbInformation ' فتح الجدول Fixed_tbl للتحقق من وجود السجل وتحديثه أو إضافته Set rs = db.OpenRecordset("Fixed_tbl", dbOpenDynaset) rs.FindFirst "fixedname = '" & fixedNameValue & "'" If rs.NoMatch Then rs.AddNew rs!fixedname = fixedNameValue Else rs.Edit End If rs!fixeddefault = fixedDefaultValue rs!fixednormal = fixedNormalValue rs!Reportname = reportNameValue rs.Update rs.Close Set rs = Nothing Set db = Nothing Exit Sub ErrorHandler: MsgBox "حدث خطأ: " & Err.Description, vbCritical If Not rs Is Nothing Then rs.Close Set rs = Nothing End If If Not db Is Nothing Then Set db = Nothing End If

Private Sub btnAdd_Click() Dim db As DAO.Database Dim rs As DAO.Recordset Dim fixedNameValue As String Dim newResultValue As String Dim fixedDefaultValue As Variant Dim fixedNormalValue As Variant Dim reportNameValue As Variant ' الحصول على القيم من الحقول fixedNameValue = Me.Fixedname newResultValue = Me.Newresult fixedDefaultValue = Me.fixeddefault fixedNormalValue = Me.fixednormal reportNameValue = Me.Reportname ' التحقق من أن القيم ليست فارغة If IsNull(fixedNameValue) Or IsNull(newResultValue) Then MsgBox "يرجى ملء جميع الحقول قبل الإضافة.", vbExclamation Exit Sub End If ' التحقق من أن الحقول الثلاثة ليست فارغة If IsNull(fixedDefaultValue) Or IsNull(fixedNormalValue) Or IsNull(reportNameValue) Then MsgBox "يرجى إدخال بيانات الحقول الثلاثة (fixeddefault, fixednormal, Reportname) قبل الإضافة.", vbExclamation Exit Sub End If ' فتح قاعدة البيانات Set db = CurrentDb ' فتح الجدول المراد الإضافة إليه Set rs = db.OpenRecordset("fixedresult_tbl", dbOpenDynaset) ' إضافة سجل جديد rs.AddNew rs!Fixedname = fixedNameValue rs!Fixedresult = newResultValue rs.Update ' إغلاق مجموعة السجلات rs.Close Set rs = Nothing ' فتح الجدول المراد التحديث إليه Set rs = db.OpenRecordset("Fixed_tbl", dbOpenDynaset) ' التحقق مما إذا كان السجل موجود بالفعل rs.FindFirst "fixedname = '" & fixedNameValue & "'" If rs.NoMatch Then ' إضافة سجل جديد rs.AddNew rs!fixedname = fixedNameValue Else ' تعديل السجل الموجود rs.Edit End If ' تحديث القيم في السجل rs!fixeddefault = fixedDefaultValue rs!fixednormal = fixedNormalValue rs!Reportname = reportNameValue rs.Update ' إغلاق مجموعة السجلات rs.Close Set rs = Nothing Set db = Nothing ' إبلاغ المستخدم بالنجاح MsgBox "تمت الإضافة بنجاح!", vbInformation End Sub جربي كده

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

صح

مش جايز اكون عندي حد علي معرفه بالتحاليل وانواعها 😉😉 بالتوفيق

بسيطه إن شاءالله Dim db As DAO.Database Dim rs As DAO.Recordset Dim sql As String Set db = CurrentDb sql = "SELECT * FROM Fixed_tbl WHERE fixedname = '" & fieldName & "'" Set rs = db.OpenRecordset(sql) If Not rs.EOF Then rs.MoveFirst Me.testnameN = fieldName & "(" & subName & ")" If Not IsNull(rs!fixeddefault) Then Me.default = rs!fixeddefault Else Me.default = Null End If If Not IsNull(rs!fixednormal) Then Me.Normal = rs!fixednormal Else Me.Normal = Null End If If Not IsNull(rs!Reportname) Then Me.Reportname = rs!Reportname Else Me.Reportname = Null End If Else ' إذا لم يتم العثور على أي سجل، تعيين الحقول كـ Null Me.testnameN = fieldName & "(" & subName & ")" Me.default = Null Me.Normal = Null Me.Reportname = Null ' عرض رسالة تنبيه MsgBox "لا يوجد قيم مسجلة لهذا التحليل", vbExclamation End If rs.Close Set rs = Nothing Set db = Nothing

لا عادي مفيش مشكله Dim db As DAO.Database Dim rs As DAO.Recordset Dim sql As String Set db = CurrentDb sql = "SELECT * FROM Fixed_tbl WHERE fixedname = '" & fieldName & "'" Set rs = db.OpenRecordset(sql) If Not rs.EOF Then rs.MoveFirst Me.testnameN = fieldName & "(" & subName & ")" If Not IsNull(rs!fixeddefault) Then Me.default = rs!fixeddefault Else Me.default = "" End If If Not IsNull(rs!fixednormal) Then Me.Normal = rs!fixednormal Else Me.Normal = "" End If If Not IsNull(rs!Reportname) Then Me.Reportname = rs!Reportname Else Me.Reportname = "" End If Else ' إذا لم يتم العثور على أي سجل، تعيين الحقول كقيمة فارغة Me.testnameN = fieldName & "(" & subName & ")" Me.default = "" Me.Normal = "" Me.Reportname = "" End If rs.Close Set rs = Nothing Set db = Nothing

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

دا عشان هو لقى فراغات خليكي فالتعديل ده Dim db As DAO.Database Dim rs As DAO.Recordset Dim sql As String Set db = CurrentDb sql = "SELECT * FROM Fixed_tbl WHERE fixedname = '" & fieldName & "'" Set rs = db.OpenRecordset(sql) If Not rs.EOF Then rs.MoveFirst Me.testnameN = fieldName & "(" & subName & ")" If Not IsNull(rs!fixeddefault) Then Me.default = rs!fixeddefault Else Me.default = "" End If If Not IsNull(rs!fixednormal) Then Me.Normal = rs!fixednormal Else Me.Normal = "" End If If Not IsNull(rs!Reportname) Then Me.Reportname = rs!Reportname Else Me.Reportname = "" End If Else MsgBox "لا يوجد سجل " & fieldName, vbExclamation End If rs.Close Set rs = Nothing Set db = Nothing

ربنا يكرمك خير ويجازيك علي كلامك الحلو ده انا تحت امرك فى اي حاجه لو اقدر مش هتأخر

مفيش اي مشكله Dim db As DAO.Database Dim rs As DAO.Recordset Dim sql As String Set db = CurrentDb sql = "SELECT * FROM Fixed_tbl WHERE fixedname = '" & fieldName & "'" Set rs = db.OpenRecordset(sql) If Not rs.EOF Then rs.MoveFirst Me.testnameN = fieldName & "(" & subName & ")" Me.default = rs!fixeddefault Me.Normal = rs!fixednormal Me.Reportname = rs!Reportname Else MsgBox "لا يوجد سجل " & fieldName, vbExclamation End If rs.Close Set rs = Nothing Set db = Nothing

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

العفو تحت امرك انا معملتش حاجه

دا أقل شئ يا غالي وحمدالله علي سلامتك يا بروف ☺️☺️

وصلتله كلامك ربنا يكرمك

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

السلام عليكم ورحمه الله وبركاته هتغير طريقه عرض التقرير للعرض العادى بعدها هتعمل زرار فالتقرير مبيظهرش غير فالعرض فقط وتحط فيه الكود التالى Dim db As DAO.Database Dim rs As DAO.Recordset Dim sql As String Set db = CurrentDb sql = "SELECT * FROM [كشف مناداه - التقييم المعرفي]" Set rs = db.OpenRecordset(sql, dbOpenDynaset) Do While Not rs.EOF If rs![ملاحظات] = "مؤجل ملف الإنجاز و المهمة" Then rs.Edit rs![ملاحظات] = "يؤدى اختبار الجدارات الأساسية فقط و يؤجل التقييم النهائى للجدارات الفنية لحين استكمال اجتياز وحدات البرنامج" rs.Update ElseIf rs![ملاحظات] = "لا يحق" Then rs.Edit rs![ملاحظات] = "يؤدى اختبار الجدارات الأساسية فقط و لا يحق له التقييم النهائى للجدارات الفنية" rs.Update End If rs.MoveNext Loop rs.Close Set rs = Nothing Set db = Nothing DoCmd.OpenReport "التقييم المعرفي", acViewPreview وده المثال اللي تم التعديل عليه draz_example.accdb

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

الشكر لله انا معملتش حاجه

لا ابدا كل الطرق زي مبيقولو تأدي الي روما تقدري تعتمدي عليه لو حبيتي من خلال الكود ده Dim strSQL1 As String Dim db As DAO.Database Dim codeValue As Variant ' التحقق من أن القائمة ليست فارغة If Me.Resultlist.ListCount = 0 Then MsgBox "لا يوجد عناصر للحذف.", vbExclamation Exit Sub End If ' التحقق من أن هناك عنصر محدد في القائمة وأن الحقل غير المنضم 'code' يحتوي على قيمة If IsNull(Me.code.Value) Or Me.code.Value = "" Then MsgBox "يرجى تحديد عنصر من القائمة للحذف.", vbExclamation Exit Sub End If ' الحصول على القيمة من الحقل غير المنضم 'code' codeValue = Me.code.Value ' إنشاء استعلام SQL لحذف السجل strSQL1 = "DELETE FROM fixedresults_tbl WHERE code = " & codeValue & ";" ' فتح قاعدة البيانات وتنفيذ استعلام الحذف Set db = CurrentDb db.Execute strSQL1, dbFailOnError ' إبلاغ المستخدم بالنجاح MsgBox "تم حذف العنصر بنجاح!", vbInformation ' تحديث ListBox لإزالة العنصر المحذوف Me.Resultlist.Requery ' تحديث الحقل غير المنضم في النموذج الرئيسي Me.code.Value = Null ' إغلاق الاتصال بقاعدة البيانات Set db = Nothing

الرجاء فضلا وليس أمرا الدعاء للاسطوره فادي ابو وسام (Foksh) ربنا يشفيه ويعافيه شفاء لا يغادر سقما اللهم امين معتقدش الراجل اتأخر عن حد قبل كده فى حاجه وحضراتكم عارفين اللي بيدعي بظهر الغيب لأخيه ربنا بيسخرله من يدعي عنه بظهر الغيب اعزروني لو مش لاقى احسن من قسم الاكسس احط فيه أقل ما يمكن لاخ وصديق محترم خلوق زيه

ولا تزعلى نفسك Dim strSQL1 As String Dim db As DAO.Database Dim codeValue As Variant ' التحقق من أن القائمة ليست فارغة If Me.Resultlist.ListCount = 0 Then MsgBox "لا يوجد عناصر للحذف.", vbExclamation Exit Sub End If ' التحقق من أن هناك عنصر محدد If Me.Resultlist.ListIndex = -1 Then MsgBox "يرجى تحديد عنصر من القائمة للحذف.", vbExclamation Exit Sub End If ' الحصول على القيمة المحددة في ListBox codeValue = Me.Resultlist.Value ' التحقق من أن القيمة ليست Null If IsNull(codeValue) Then MsgBox "يرجى تحديد عنصر من القائمة للحذف.", vbExclamation Exit Sub End If ' إنشاء استعلام SQL لحذف السجل strSQL1 = "DELETE FROM fixedresults_tbl WHERE code = " & codeValue & ";" ' فتح قاعدة البيانات وتنفيذ استعلام الحذف Set db = CurrentDb db.Execute strSQL1, dbFailOnError ' إبلاغ المستخدم بالنجاح MsgBox "تم حذف العنصر بنجاح!", vbInformation ' تحديث ListBox لإزالة العنصر المحذوف Me.Resultlist.Requery ' تحديث الحقل غير المنضم في النموذج الرئيسي إذا كان يحتوي على القيمة المحذوفة If Me.code.Value = codeValue Then Me.code.Value = Null End If ' إغلاق الاتصال بقاعدة البيانات Set db = Nothing

تمام ضيفنا شرط أنه يتحقق من تحديد العنصر قبل الحذف Dim strSQL1 As String Dim db As DAO.Database Dim codeValue As Variant ' التحقق من أن هناك عنصر محدد If Me.Resultlist.ListIndex = -1 Then MsgBox "يرجى تحديد عنصر من القائمة للحذف.", vbExclamation Exit Sub End If ' الحصول على القيمة المحددة في ListBox codeValue = Me.Resultlist.Value ' التحقق من أن القيمة ليست Null If IsNull(codeValue) Then MsgBox "يرجى تحديد عنصر من القائمة للحذف.", vbExclamation Exit Sub End If ' إنشاء استعلام SQL لحذف السجل strSQL1 = "DELETE FROM fixedresults_tbl WHERE code = " & codeValue & ";" ' فتح قاعدة البيانات وتنفيذ استعلام الحذف Set db = CurrentDb db.Execute strSQL1, dbFailOnError ' إبلاغ المستخدم بالنجاح MsgBox "تم حذف العنصر بنجاح!", vbInformation ' تحديث ListBox لإزالة العنصر المحذوف Me.Resultlist.Requery ' تحديث الحقل غير المنضم في النموذج الرئيسي إذا كان يحتوي على القيمة المحذوفة If Me.code.Value = codeValue Then Me.code.Value = Null End If ' إغلاق الاتصال بقاعدة البيانات Set db = Nothing

ممكن طبعا Dim strSQL1 As String Dim db As DAO.Database Dim codeValue As Variant ' الحصول على القيمة المحددة في ListBox codeValue = Me.Resultlist.Value ' التحقق من أن هناك عنصر محدد If IsNull(codeValue) Then MsgBox "يرجى تحديد عنصر من القائمة للحذف.", vbExclamation Exit Sub End If ' إنشاء استعلام SQL لحذف السجل strSQL1 = "DELETE FROM fixedresults_tbl WHERE code = " & codeValue & ";" ' فتح قاعدة البيانات وتنفيذ استعلام الحذف Set db = CurrentDb db.Execute strSQL1, dbFailOnError ' إبلاغ المستخدم بالنجاح MsgBox "تم حذف العنصر بنجاح!", vbInformation ' تحديث ListBox لإزالة العنصر المحذوف Me.Resultlist.Requery ' تحديث الحقل غير المنضم في النموذج الرئيسي إذا كان يحتوي على القيمة المحذوفة If Me.code.Value = codeValue Then Me.code.Value = Null End If ' إغلاق الاتصال بقاعدة البيانات Set db = Nothing