Barna

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

مبروك لنا ولك استاذ @محب العقيدة .... اسأل الله لك مزيدا من العلم وان ينفع بعلمك

برنامجك غير مقسم صحيح لذلك تظهر هذه المشكلة

وعليكم السلام ورحمة الله هل هذه القاعدة موجودة في المسار X:\samer_2022\Tbl_Operation.accdb اذا موجودة افتحها واعمل ضغط واصلاح قد تكون القاعدة مستخدمة من تطبيق اخر

هل التصور صحيح في الصورة ................. Private Sub أمر309_Click() Dim rst As DAO.Recordset Dim db As DAO.Database Dim ctl As Control Dim controlsList As New Collection Dim dorAwalField As String, dorThanField As String, finalField As String Dim dorAwalVal As Variant, dorThanVal As Variant, finalVal As Variant Dim i As Integer Dim excludedNames As Variant Set db = CurrentDb() Set rst = Me.RecordsetClone ' نسخة من مصدر بيانات النموذج ' أسماء الحقول التي نريد استثناؤها (اسم الطالب، رقم الجلوس) excludedNames = Array("num_Glos", "name_student") ' جمع أسماء الحقول المرتبطة بالدرجات، حسب ترتيب مربعات النص في النموذج For Each ctl In Me.Controls If ctl.ControlType = acTextBox Then If IsExcluded(ctl.Name, excludedNames) = False Then If ctl.ControlSource <> "" Then controlsList.Add ctl.ControlSource End If End If End If Next ctl ' المرور على جميع السجلات وتحديث الدرجات If Not rst.EOF Then rst.MoveFirst Do While Not rst.EOF rst.Edit For i = 1 To controlsList.Count Step 3 If i + 2 <= controlsList.Count Then dorAwalField = controlsList(i) dorThanField = controlsList(i + 1) finalField = controlsList(i + 2) dorAwalVal = Nz(rst(dorAwalField), 0) dorThanVal = rst(dorThanField) ' بدون Nz حتى نتحقق من Null ' تنفيذ القاعدة: If IsNull(dorThanVal) Then finalVal = dorAwalVal ElseIf dorThanVal = -1 Then finalVal = -1 ElseIf dorThanVal >= 50 Then finalVal = 50 Else finalVal = dorThanVal End If rst(finalField) = finalVal End If Next i rst.Update rst.MoveNext Loop rst.Close Set rst = Nothing Set db = Nothing Me.Requery ' لتحديث النموذج بعد التعديل MsgBox "تم تحديث جميع الدرجات النهائية بنجاح.", vbInformation End Sub

استبدل الكود الموجود تحت الزر فقط بهذه الشيفرة ........... Private Sub أمر309_Click() Dim rst As DAO.Recordset Dim db As DAO.Database Dim ctl As Control Dim controlsList As New Collection Dim dorAwalField As String, dorThanField As String, finalField As String Dim dorAwalVal As Variant, dorThanVal As Variant, finalVal As Variant Dim i As Integer Dim excludedNames As Variant Set db = CurrentDb() Set rst = Me.RecordsetClone ' نسخة من مصدر بيانات النموذج ' أسماء الحقول التي نريد استثناؤها (اسم الطالب، رقم الجلوس) excludedNames = Array("num_Glos", "name_student") ' جمع أسماء الحقول المرتبطة بالدرجات، حسب ترتيب مربعات النص في النموذج For Each ctl In Me.Controls If ctl.ControlType = acTextBox Then If IsExcluded(ctl.Name, excludedNames) = False Then If ctl.ControlSource <> "" Then controlsList.Add ctl.ControlSource End If End If End If Next ctl ' المرور على جميع السجلات وتحديث الدرجات If Not rst.EOF Then rst.MoveFirst Do While Not rst.EOF rst.Edit For i = 1 To controlsList.Count Step 3 If i + 2 <= controlsList.Count Then dorAwalField = controlsList(i) dorThanField = controlsList(i + 1) finalField = controlsList(i + 2) dorAwalVal = Nz(rst(dorAwalField), 0) dorThanVal = Nz(rst(dorThanField), -1) If dorThanVal = -1 Then finalVal = -1 ElseIf dorThanVal >= 50 Then finalVal = 50 Else finalVal = dorThanVal End If rst(finalField) = finalVal End If Next i rst.Update rst.MoveNext Loop rst.Close Set rst = Nothing Set db = Nothing Me.Requery ' لتحديث النموذج بعد التعديل MsgBox "تم تحديث جميع الدرجات النهائية بنجاح.", vbInformation End Sub

هل هذه الحالة موجودة من ضمن السجلات في المرفق السابق ؟؟؟؟؟

هذه هي الصورة الناتجة ماذا تريد ؟؟؟؟ هل تريد مكان الدرجة النهائية يكتب 0 أم ماذا وضح بالشرح الكافي

تفضل ................. cont.accdb

استخدم هذه الشيفرة في زر التحديث مع اللاحقة له ...... Private Sub أمر309_Click() Dim rst As DAO.Recordset Dim db As DAO.Database Dim ctl As Control Dim controlsList As New Collection Dim dorAwalField As String, dorThanField As String, finalField As String Dim dorAwalVal As Variant, dorThanVal As Variant, finalVal As Variant Dim i As Integer Dim excludedNames As Variant Set db = CurrentDb() Set rst = Me.RecordsetClone ' نسخة من مصدر بيانات النموذج ' أسماء الحقول التي نريد استثناؤها (اسم الطالب، رقم الجلوس) excludedNames = Array("name_student", "num_Glos") ' جمع الحقول الثلاثية فقط حسب الترتيب For Each ctl In Me.Controls If ctl.ControlType = acTextBox Then If IsExcluded(ctl.Name, excludedNames) = False Then If ctl.ControlSource <> "" Then ' مرتبط بحقل فعلي controlsList.Add ctl.ControlSource End If End If End If Next ctl ' المرور على كل سجل في النموذج If Not rst.EOF Then rst.MoveFirst Do While Not rst.EOF rst.Edit For i = 1 To controlsList.Count Step 3 If i + 2 <= controlsList.Count Then dorAwalField = controlsList(i) dorThanField = controlsList(i + 1) finalField = controlsList(i + 2) dorAwalVal = Nz(rst(dorAwalField), 0) dorThanVal = Nz(rst(dorThanField), -1) If dorThanVal <> -1 Then If dorThanVal >= 50 Then finalVal = 50 Else finalVal = dorThanVal End If Else finalVal = dorAwalVal End If rst(finalField) = finalVal End If Next i rst.Update rst.MoveNext Loop rst.Close Set rst = Nothing Set db = Nothing Me.Requery ' لتحديث العرض في النموذج MsgBox "تم تحديث جميع الدرجات النهائية بنجاح.", vbInformation End Sub Private Function IsExcluded(fieldName As String, excludedList As Variant) As Boolean Dim item As Variant For Each item In excludedList If LCase(fieldName) = LCase(item) Then IsExcluded = True Exit Function End If Next item IsExcluded = False End Function وهذا ملفك بعد التعديل ............... cont.accdb

بل نريد الطريقة ربما افضل من طريقتي ونتعلم منها بارك الله فيك

هل الصورة الموجودة في النموذج بعد التحديث هو المطلوب

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

اشكرك اخي طاهر .... بارك الله فيك .... شغال على برنامج قطعني عن المنتدى ... جرب المرفق على الحالات السابقة والحالة الحالية حتى نتأكد من الكود .... Taher_1.mdb