اذهب الي المحتوي
أوفيسنا

M.Abd Allah

03 عضو مميز
  • Posts

    161
  • تاريخ الانضمام

  • تاريخ اخر زياره

  • Days Won

    3

كل منشورات العضو M.Abd Allah

  1. ولا تزعلى نفسك 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
  2. تمام ضيفنا شرط أنه يتحقق من تحديد العنصر قبل الحذف 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
  3. ممكن طبعا 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
  4. تمام يبقي استخدمي الكود ده Private Sub btnAdd_Click() Dim db As DAO.Database Dim rs As DAO.Recordset Dim fixedNameValue As String Dim newResultValue As String Dim sql As String ' الحصول على القيم من الحقول والتحقق من أنها ليست Null If IsNull(Me.Fixedname) Or IsNull(Me.Newresult) Then MsgBox "يرجى ملء جميع الحقول قبل الإضافة.", vbExclamation Exit Sub End If fixedNameValue = Me.Fixedname.Value newResultValue = Me.Newresult.Value ' التحقق من أن القيم ليست فارغة If fixedNameValue = "" Or newResultValue = "" Then MsgBox "يرجى ملء جميع الحقول قبل الإضافة.", vbExclamation Exit Sub End If ' فتح قاعدة البيانات Set db = CurrentDb ' التحقق من عدم وجود قيمة مكررة لنفس Fixedname و Fixedresult sql = "SELECT COUNT(*) AS RecordCount FROM fixedresult_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 ' إنشاء تعليمة SQL لإضافة سجل جديد sql = "INSERT INTO fixedresult_tbl (Fixedname, Fixedresult) " & _ "VALUES ('" & fixedNameValue & "', '" & newResultValue & "')" ' تنفيذ تعليمة SQL db.Execute sql, dbFailOnError ' إغلاق قاعدة البيانات Set db = Nothing ' إبلاغ المستخدم بالنجاح MsgBox "تمت الإضافة بنجاح!", vbInformation End Sub
  5. ممكن دا يتوقف علي اسماء حقولك أو طريقه استخدامك لاكواد أو استعلامات
  6. طيب جربي ده كده Private Sub btnAdd_Click() Dim db As DAO.Database Dim fixedNameValue As String Dim newResultValue As String Dim sql As String ' الحصول على القيم من الحقول والتحقق من أنها ليست Null If IsNull(Me.Fixedname) Or IsNull(Me.Newresult) Then MsgBox "يرجى ملء جميع الحقول قبل الإضافة.", vbExclamation Exit Sub End If fixedNameValue = Me.Fixedname.Value newResultValue = Me.Newresult.Value ' التحقق من أن القيم ليست فارغة If fixedNameValue = "" Or newResultValue = "" Then MsgBox "يرجى ملء جميع الحقول قبل الإضافة.", vbExclamation Exit Sub End If ' فتح قاعدة البيانات Set db = CurrentDb ' إنشاء تعليمة SQL لإضافة سجل جديد sql = "INSERT INTO fixedresult_tbl (Fixedname, Fixedresult) " & _ "VALUES ('" & fixedNameValue & "', '" & newResultValue & "')" ' تنفيذ تعليمة SQL db.Execute sql, dbFailOnError ' إغلاق قاعدة البيانات Set db = Nothing ' إبلاغ المستخدم بالنجاح MsgBox "تمت الإضافة بنجاح!", vbInformation End Sub
  7. قدام حضرتك عندك المثال بتاعك ممكن تحطه وإن شاء الله نحاول نعدلك عليه
  8. طيب جربى الكود ده ان شاء الله هيشتغل كويس Private Sub btnAdd_Click() Dim db As DAO.Database Dim fixedNameValue As String Dim newResultValue As String Dim sql As String ' الحصول على القيم من الحقول fixedNameValue = Me.Fixedname newResultValue = Me.Newresult ' التحقق من أن القيم ليست فارغة If IsNull(fixedNameValue) Or fixedNameValue = "" Or IsNull(newResultValue) Or newResultValue = "" Then MsgBox "يرجى ملء جميع الحقول قبل الإضافة.", vbExclamation Exit Sub End If ' فتح قاعدة البيانات Set db = CurrentDb ' إنشاء تعليمة SQL لإضافة سجل جديد sql = "INSERT INTO fixedresult_tbl (Fixedname, Fixedresult) " & _ "VALUES ('" & fixedNameValue & "', '" & newResultValue & "')" ' تنفيذ تعليمة SQL db.Execute sql, dbFailOnError ' إغلاق قاعدة البيانات Set db = Nothing ' إبلاغ المستخدم بالنجاح MsgBox "تمت الإضافة بنجاح!", vbInformation End Sub
  9. فى قاعده التحقق من الصحة الحقول اللى عايز تعملها اكتب Is Not Null
  10. ممكن من خلال الكود التالي Private Sub btnAdd_Click() Dim db As DAO.Database Dim rs As DAO.Recordset Dim fixedNameValue As String Dim newResultValue As String ' الحصول على القيم من الحقول fixedNameValue = Me.Fixedname newResultValue = Me.Newresult ' التحقق من أن القيم ليست فارغة If IsNull(fixedNameValue) Or IsNull(newResultValue) Then MsgBox "يرجى ملء جميع الحقول قبل الإضافة.", 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 db = Nothing ' إبلاغ المستخدم بالنجاح MsgBox "تمت الإضافة بنجاح!", vbInformation End Sub
  11. ينفع إن شاءالله مفيش حاجه فالغالب متنفعش فالاكسس الا حاجات نادره جدا
  12. وحسب ما فهمت كده من اخر طلب إن كل الاعتماد فى أغلب النماذج علي جدول fixed_tbl اللي فيه كل انواع التحاليل غيرت الكود فى موديل ليتناسب مع اي نموذج واعتقد كده لا داعى لوجود التكست بوكس والكمبو بوكس ممكن تحل محلهم كلهم كما بالمثال وطبعا ينفع تعملي اكتر من كمبو بوكس وتستدعي تحاليل مختلفه وبرضو ينفع يتعمل اكتر من نتيجه تحاليل فى نفس النموذج والموديل هيكون ثابت فقط تغيري اسماء الحقول الجديده وتعملي موديل ( دا إن وجد اكتر من تحليل في نفس النموذج ) لو مكانش مش هيتم تغيير اي حاجه وفالمثال نموذجين مختلفين وبيعملوا نفس النتيجه مع نفس الموديول safaa edit.accdb
  13. دا نورك يا خال انا كان بقالي يجي بتاع ٤ سنين هنا وكنت ناسي الرقم السري ☺️☺️☺️
  14. تمام انا كده تقريبا فهمت بس معلشي مكنتش شوفت التعليق غير لما خلصت الملف ده شوفى كده عملت فورم تاني واحد بيشتغل زي مهو بالاكواد والتاني بيشتغل بالماكرو للعلم ينفع يتم دمج الماكرو مع بعض ولكن انا عملت كل واحد منفصل عشان يبقي سهل عليكي تعمليه وتعدلي فيه جربي كده وان شاء الله هبقي اعملك باقي التحاليل بالطريقه بتاعتك safaa new.accdb
  15. بالتوفيق إن شاءالله ومتشكر المايسترو الكبير جعفر على إيضاح طريقه وضع الكود تحياتي
  16. بسيطه إن شاءالله شوفي لو عايزه تعملي حاجه تانيه بالمره مفيش مشكله 🤓
  17. والله انا مش متأخر بس انا فعلا أغلب الوقت مبفهمش بسهوله أو فعلا جايز مبعرفش اعبر فلو حابه تعملي حاجه تانيه ياريت حتي تعملي برسمه شبه الصوره اللي حطيتيها فالاول أو حتي اكتبي صوره بخط الايد وقولي عايزه هنا اضغط كذا او اعمل كذا أو اكتب كذا يظهرلي فالحته دي كذا و الباقي إن شاءالله بسيط
  18. جرب الصيغه دي كده إن شاءالله تظبط معاك INSERT INTO بنود_حجز_البضاعة ( رقم_الحركة, مستلم_الطلب, المسئول_عن_الطلب, محرر_الطلبية, العدد, الصنف, سعر_الوحدة, كود_الصنف_الفرعى, كود_الصنف_الرئيسى, الكمية_المحجوزة, صورة_الصنف, ملاحظات_البند, اجمالى, رقم_الفاتورة, رقم_الحجز ) SELECT بنود_عرض_السعر.رقم_الحركة , بنود_عرض_السعر.مستلم_الطلب , بنود_عرض_السعر.المسئول_عن_الطلب , بنود_عرض_السعر.محرر_الطلبية , بنود_عرض_السعر.العدد , بنود_عرض_السعر.الصنف , بنود_عرض_السعر.سعر_الوحدة , بنود_عرض_السعر.كود_الصنف_الفرعى , بنود_عرض_السعر.كود_الصنف_الرئيسى , بنود_عرض_السعر.الكمية_المحجوزة , بنود_عرض_السعر.صورة_الصنف , بنود_عرض_السعر.ملاحظات_البند , بنود_عرض_السعر.اجمالى , بنود_عرض_السعر.رقم_الفاتورة , بنود_عرض_السعر.رقم_الحجز FROM بنود_عرض_السعر LEFT JOIN بنود_حجز_البضاعة ON بنود_عرض_السعر.[رقم_الحجز] = بنود_حجز_البضاعة.[رقم_الحجز] WHERE ((بنود_عرض_السعر.رقم_الفاتورة)=0 AND (بنود_عرض_السعر.رقم_الحجز)=[Forms]![form5]![tx] AND (بنود_حجز_البضاعة.رقم_الحجز Is Null)) OR ((بنود_عرض_السعر.رقم_الفاتورة Is Null))
  19. انا اصلا مبقاش يعنيني موضوع تقييم الاجابات لاني فهمت الموضوع ببساطه كل مافي الموضوع اني أغلب الوقت بفهم بالمشقلب أو اوقات مبفهمش الموضوع صح عندي ثقه إن شاءالله مفيش اي مشكله ملهاش حل بس اكون فاهم كويس ايه المطلوب وجايز مش مشكله عندك اكيد المشكله عندي اني مش فاهم ايه المطلوب بالظبط تحياتي
  20. مش فاهم يعني قصدك عايزه تكتبي فى حقل volume مثلا يظهر نفس النتائج دي فالحقول الغير منضمه اللي بتطابق مع الجدول التاني ولا أنا فاهم غلط ؟ ولو ده مش قصدك وقصدك تستعملي الدوال بتاعتك فى النموذج تقدري تخليها زي ماكانت فى default value حطي الدوال ونفس الاكواد اللي معملوله هتشتغل معاكي كويس بمجرد التركيز علي حقل هيظهر النتائج اللي عايزاها ( بس معلشي ايه لزومها بالطريقه دي المفروض القيم تكون متغيره قدام هتعتمدي علي الجدول الاول يبقي محتاجه عالاقل انها تكون متغيره أو عالاقل تتعمل كومبو بوكس بحيث لما تختاري منها قيمه يظهرلك القيم المماثله من الجدول التاني فالنموذج
  21. تم الغاء الداله حسب فهمي بما ان الحقول المفروض تاخد من الجدول الفاضي تم عمل سجل فالجدول الفاضي للتجربه عليه safaa n.accdb
  22. On Error Resume Next If MsgBox("هل أنت متأكد من حذف بيانات المريض؟", vbYesNo, "تأكيد الحذف") = vbYes Then DoCmd.SetWarnings False Dim strSQL1 As String Dim strSQL2 As String strSQL1 = "DELETE FROM test_order_tbl WHERE ID = " & Forms![reservation_frm]![ID] strSQL2 = "DELETE FROM reservation_tbl WHERE ID = " & Forms![reservation_frm]![ID] DoCmd.RunSQL strSQL1 DoCmd.RunSQL strSQL2 DoCmd.SetWarnings True ' إعادة تحديث البيانات في النموذج بعد الحذف Forms![reservation_frm].Requery Else DoCmd.CancelEvent End If
  23. وعليكم السلام ورحمه الله وبركاته طيب تمام جرب الكود ده كده واهم حاجه تتأكد أن اعدادات الطابعه أنها بتدعم duplex Private Sub PrintReports_Click() Dim reportNumber As String Dim prt As Printer ' افترض أن "رقم التقرير" هو اسم حقل النص في النموذج reportNumber = Me!رقم_التقرير On Error GoTo ErrorHandler ' تعيين الطابعة للطباعة على الوجهين For Each prt In Application.Printers If prt.DeviceName = Application.Printer.DeviceName Then prt.Duplex = acPRDPVertical ' تعيين الطباعة على الوجهين Exit For End If Next prt ' فتح التقرير أ باستخدام رقم التقرير كمعيار DoCmd.OpenReport "التقرير أ", acViewPreview, , "رقم_التقرير = '" & reportNumber & "'" DoCmd.PrintOut , , , , , True ' الطباعة على الوجه الأول ' إغلاق التقرير أ DoCmd.Close acReport, "التقرير أ" ' فتح التقرير ب باستخدام نفس المعيار DoCmd.OpenReport "التقرير ب", acViewPreview, , "رقم_التقرير = '" & reportNumber & "'" DoCmd.PrintOut , , , , , False ' الطباعة على الوجه الثاني ' إغلاق التقرير ب DoCmd.Close acReport, "التقرير ب" Exit Sub ErrorHandler: MsgBox "حدث خطأ أثناء الطباعة: " & Err.Description, vbCritical End Sub
×
×
  • اضف...

Important Information