منع التحديد المتعدد في خانة مربع الاختيار، في النموذج المستمر

[شايب]

48 دقائق مضت, jjafferr said:

واشوف انك تداركت الخطأ في النسخة الاخيرة 🙂

مازال هناك خطأ

عند اختيار السجل الاول ثم الغاء الاختيار نحصل على رسالة خطأ

الشايب

 

[ابو عارف]

3 دقائق مضت, شايب said:

مازال هناك خطأ

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

HH.accdb

[شايب]

4 دقائق مضت, ابو عارف said:

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

ممتاز لم اجد اي خطأ وعالج مشكلة التعديل من الجدول

استاذ يا ابا عارف 🌹

اخونا الشايب

[ابو جودي]

طيب وممكن رايكم بالكود التالى 

 

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

[أبوبسمله]

السلام عليكم

افتقدت احاديثكم الشيقه والمثمره اخوتى واساتذتى الكرام @jjafferr و @شايب اسال الله ان يجازيكم عنا كل خير

تقبلوا تحياتى

[AbuuAhmed]

في 27‏/1‏/2025 at 13:08, abofayez1 said:

أشكرك أخي kkhalifa1960

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

لم أطلع على كل الحلول ولكن حل الأستاذ @kkhalifa1960 فكرته ذكية وحل مشكلة التركيز في الكود التالي:
 

Private Sub y_n_AfterUpdate()
    ' تحديث جميع السجلات الأخرى لإلغاء التحديد
    If Me.y_n.Value = True Then
        Dim strSQL As String
        Dim Bm
        
        ' SQL لإلغاء التحديد عن جميع السجلات باستثناء الحالي
        strSQL = "UPDATE a SET y_n = False WHERE ID <> " & Me.id
        CurrentDb.Execute strSQL, dbFailOnError
        
        ' إعادة استعلام النموذج لعرض التغييرات
        Bm = Me.Bookmark
        Me.Requery
        Me.Bookmark = Bm
        
    End If
End Sub

 

تم تعديل بالامس في 02:15 بواسطه AbuuAhmed

[jjafferr]

السلام عليكم

لا ما خلص الموضوع 

 

تذكرون لما قلت:

في 28‏/1‏/2025 at 12:01, jjafferr said:

للعلم ، عند تقديمي لإقتراح ، فانا انظر لقاعدة البيانات وكأن بها على الاقل 10,000 سجل.

.

انزلت قاعدة بيانات التجربة:

 

واستعملت 9,999 سجل فقط ، واضفت جميع الاجابات في هذا الموضوع:

.

ارجو من اللي يريد يشارك ويعدل الكود حقه ان :

1. يشغل الاستعلام qry_Half_y_n_True واللي يختار حوالي 5000 سجل ويعملهم صح ،

2. يشغل نموذجه ويشوف سرعته ، ويقارنه مع سرعة النماذج الاخرى.

 

طبعا انا كان عندي وقتي من الصبح ، واضفت النموذج الثاني حقي ، وهو الاسرع (مثل ما يقول المثل: مَحَّد يقول دِبْسي حامِض )

 

جعفر

1624.Stress_Test.mdb.zip

[شايب]

منذ ساعه, jjafferr said:

طبعا انا كان عندي وقتي من الصبح ، واضفت النموذج الثاني حقي ، وهو الاسرع (مثل ما يقول المثل: مَحَّد يقول دِبْسي حامِض )

هذه تجربة الاخ شايب

عدد السجلات المؤشرة بعد تنفيذ الاستعلام 4998 سجل

• جعفر 1 خارج المقارنة وذلك بسبب

في 27‏/1‏/2025 at 20:38, شايب said:

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

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

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

اخيرا تم التشغيل على جهاز قديم متوسط المواصفات

معالج i9 الجيل العاشر و128 جيجا رام ونظام تشغيل ويندوز 11 الاصدار 24H2

والله الموفق

الشايب

[AbuuAhmed]

وهذا كودي مستقلا وبه "خدعة" إن صح التعبير لإظهار البيانات بعد التحديث.
 

Private Sub y_n_AfterUpdate()
    Me.Refresh
    DoCmd.RunSQL "UPDATE employees SET [y_n] = 0 WHERE [y_n]=-1 AND ID<>" & Me.ID & ";"
        
    With Me.y_n
        .ControlSource = ""
        .ControlSource = "y_n"
    End With
End Sub

 

[jjafferr]

23 دقائق مضت, AbuuAhmed said:

    With Me.y_n
        .ControlSource = ""
        .ControlSource = "y_n"
    End With

مافي داعي لهذه الجزئية ، فالكود يعمل بدونها ، إلا اذا فيه شيء تحب تخبرنا عنه 🙂

 

وطبعا

Me.Refresh   = DoCmd.RunCommand acCmdSaveRecord   = If Me.Dirty Then Me.Dirty = False

 

واذ تحب تخبرنا عن الخدعة 🙂

[شايب]

33 دقائق مضت, AbuuAhmed said:

وهذا كودي مستقلا

ماشاء الله خلال ثانية تقريبا تم التنفيذ

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

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

ولكن هذه ليست مفاضلة وانما تجربة تشغيل لغير متخصص

[ابو عارف]

1 ساعه مضت, شايب said:

كود الاستاذ ابو عارف 2 يستغرق وقت طويل ثم اضطررت الى اغلاق الملف بشكل اجباري

السبب هو اصدار الاكسس قديم  حتى لو 5 سجلات لا يعمل و هذا المرفق الجديد

NewTest.accdb

تم تعديل بالامس في 18:53 بواسطه ابو عارف

[AbuuAhmed]

19 دقائق مضت, jjafferr said:

مافي داعي لهذه الجزئية ، فالكود يعمل بدونها ، إلا اذا فيه شيء تحب تخبرنا عنه 🙂

بعد فحصي الآن كلامك صحيح، مع أن وقت كتابتي للكود كنت لا أرى أثر التحديث إلا بعد "الخدعة":
 

With Me.y_n
    .ControlSource = ""
    .ControlSource = "y_n"
End With

طبعا عملتها تجنبا لاستخدام Requery والرجوع إلى السجل الحالي.
طبعا من الجيد قبل الاختبار فتح الجدول وتبديل قيمة y_n لعدة سجلات لتكون الصورة أكثر وضوحا.

ماذا لو فهرسنا حقل y_n هل ستختلف السرعة؟

[jjafferr]

9 دقائق مضت, AbuuAhmed said:

ماذا لو فهرسنا حقل y_n هل ستختلف السرعة؟

فكرة جيدة ، ولكن لوسمحت ارفع السقف الى 50000 سجل او اكثر ، حتى نرى الفارق بسهولة 🙂

 

 

[AbuuAhmed]

10 دقائق مضت, jjafferr said:

فكرة جيدة ، ولكن لوسمحت ارفع السقف الى 50000 سجل او اكثر ، حتى نرى الفارق بسهولة

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

سنقبل بالنتائج منك ولن نفحص بعدك ولا داعي لرفع قاعدة البيانات أيضا.

 

اسمح لي أطلب منك فأنا أتواصل معكم ومسغول في مشروع برمجة بعيدا عن الأكسس والفي بي أي.

[jjafferr]

بسبب تقارب طرق الكود ، تم الاستعانه بـ 300,000 سجل ، ووضع البيانات على كمبيوتر آخر على الشبكة ،

وللأسف كود ابو عارف ما اشتغل بالطريقة الصحيحة ، فلم اجربه.

 

الثلاث مرات الاولى ، اشغل الاستعلام ليعمل حوالي 40,000 صح ، ثم اغير في النموذج ،

والثلاث مرات التالية ، هي وانا في النموذج ، اختار سجل واعمله صح.

والنتيجة بالثواني

+----------------+----------------+----------------+
| AbuuAhmed      | jjafferr_2     | ابو جودي       |
+================+================+================+
| 4.43701171875  | 4.421875       | 4.828125       |
+----------------+----------------+----------------+
| 4.468994140625 | 4.406005859375 | 4.110107421875 |
+----------------+----------------+----------------+
| 4.468017578125 | 4.406005859375 | 4.31201171875  |
+----------------+----------------+----------------+
| 0.546875       | 0.468994140625 | 4.31201171875  |
+----------------+----------------+----------------+
| 0.531005859375 | 0.468994140625 | 4.31298828125  |
+----------------+----------------+----------------+
| 0.546875       | 0.468994140625 | 3.984130859375 |
+----------------+----------------+----------------+

 

جعفر

 

تم الاستعانه بالموقع التالي لعمل الجدول: https://www.tablesgenerator.com/text_tables 

1624.Stress_Test.mdb.zip

[AbuuAhmed]

22 دقائق مضت, jjafferr said:

بسبب تقارب طرق الكود ، تم الاستعانه بـ 300,000 سجل ، ووضع البيانات على كمبيوتر آخر على الشبكة

أشكرك كثيرا سأقوم بإعادة المقارنة بعد عمل فهرس لحقل y_n
توني أنتبه أن حلك الثاني نفس عبارة sql لحلي وكأني عملت نسخ ولصق لحلك! لم أنتبه له من قبل!!
صدق المثل القائل "إذا عرف السبب بطل العجب" 🙂 

[ابو عارف]

40 دقائق مضت, jjafferr said:

وللأسف كود ابو عارف ما اشتغل بالطريقة الصحيحة ، فلم اجربه.

انظر في المرفق أكثر من 300000 سجل

NewTest.rar

[Foksh]

بما أن الموضوع حماسي ، وتبارك الله مشاركات وأفكار عظيمة ,,
 

أشارك معكم فكرة على الهامش 

 

Private isProcessing As Boolean

Private Sub y_n_BeforeUpdate(Cancel As Integer)
    If isProcessing Then Exit Sub
    isProcessing = True
    With Me.RecordsetClone
        .FindFirst "[y_n]=-1"
        .Edit
        !y_n = 0
        .Update
    End With
    isProcessing = False
End Sub

 

[ابو عارف]

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

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

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

الكود و المرفق

Dim src As String
src = Me.RecordSource
Dim Rc As Integer
Dim rst As Recordset
Set rst = Form.RecordsetClone
Rc = DCount("[y_n]", src, "[y_n]=-1")
  With rst
  Do While Rc > 0
    .FindFirst "[y_n]=-1"
    .Edit
    !y_n = 0
    .Update
    Rc = Rc - 1
    Loop
    End With

Hr_data.rar

تم تعديل منذ 10 ساعات بواسطه ابو عارف

[شايب]

45 دقائق مضت, ابو عارف said:

و وجهة نظر  @شايب (إلغاء محددات متعددة سواء دخل مباشر من جدول أو من قبل مستخدم آخر على الشبكة أو أي سبب آخر لان الحقل أساسا قابل حفظ المتعدد)

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

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

اخير لفت نظري في مشاركتكم استاذي السطر السادس حيث تم حجز متغيير ولم يتم استخدامه او اسناد قيمه له

اخونا الشايب

[AbuuAhmed]

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

1624.Stress_Test_20.mdb

[ابو عارف]

4 ساعات مضت, شايب said:

السطر السادس حيث تم حجز متغيير ولم يتم استخدامه او اسناد قيمه له

تم ازالة متغير كنت استخدمه بدل while في البداية و نسيت احذفه

[ابو عارف]

 

الاستاذ @AbuuAhmed  اصدار قديم الاكسس لا يدعم دوال Execute و SearchForRecord  من فضلك جرب الكود التالي في اكسس لديك

Dim src As String
src = Me.RecordSource
Dim Rc As Integer
Dim rst As Recordset
Set rst = Form.RecordsetClone
Dim i
Rc = DCount("[y_n]", src, "[y_n]=-1")
  With rst
  Do While Rc > 0
    .FindFirst "[y_n]=-1"
    .Edit
    !y_n = 0
    .Update
    Rc = Rc - 1
    Loop
    End With
    
    Beep
    DoCmd.SetWarnings (-1)
End Sub

 

و المرفق موجود في مشاركتي الاخيرة

ولكم مني اجمل تحايا

تم تعديل منذ 8 ساعات بواسطه ابو عارف

[ابو جودي]

واو الموضوع كبـــــــر

يسعدنى ان اشارك عظماء المنتدى واساتذتى الأجلاء فى هذه الافكار 

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

 

طيب وما رأيكم استاذ @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 & " ثانية"