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

**kaser906** · ديسمبر 26, 2017

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

المثال المرفق

قام بعمله الأستاذ جعفر ( حفظه الله ورعاه ) وهو يحنوي على كود خلف زر أمر أعمل السجلات

 Dim rst As DAO.Recordset
    Dim rstSUB As DAO.Recordset
     
    'نجهز الجدول لإدخال بيانات رقم المقعد
    Set rst = CurrentDb.OpenRecordset("Select * From Tabl_bus")
    
    'نقرأ بيانات النموذج الفرعي
    Set rstSUB = Me.Forme_Sub_Itinerary.Form.RecordsetClone
    rstSUB.MoveLast: rstSUB.MoveFirst
    RCsub = rstSUB.RecordCount
    
    'نقرأ كل سجل من سجلات النموذج الفرعي
    For j = 1 To RCsub
               
        'اذا يوجد علامة صح في حقل "اعمل التغييرات" فقم بحذف السجلات السابقة لهذا الخط ، واعمله من جديد
        If rstSUB!Do_Changes = -1 Then
        
            'نحذف سجلات رقم المقعد من الجدول
            mySQL = "DELETE Tabl_bus.Num_Itinerary_ID, Tabl_bus.Num_Itinerary, Tabl_bus.Num_rihla, Tabl_bus.*"
            mySQL = mySQL & " FROM Tabl_bus"
            mySQL = mySQL & " WHERE Num_Itinerary_ID=" & rstSUB!Auto_ID
            mySQL = mySQL & " AND Num_Itinerary=" & rstSUB!Num_Itinerary
            mySQL = mySQL & " AND Num_rihla=" & rstSUB!Num_rihla
            CurrentDb.Execute mySQL
            
            'نقوم بتغيير حقل "اعمل التغييرات" ونزيل الصح منها
            rstSUB.Edit
                rstSUB!Do_Changes = 0
            rstSUB.Update
            
            
            
            'نعمل سجلات رقم المقعد في الجدول
            For i = 1 To rstSUB!Number_seats
                rst.addnew
                    rst!Num_Itinerary_ID = rstSUB!Auto_ID
                    rst!Num_Itinerary = rstSUB!Num_Itinerary
                    rst!Num_rihla = rstSUB!Num_rihla
                    rst![Chair_ No] = i
                rst.Update
            Next i
        
        End If 'rstSUB
        rstSUB.MoveNext
    Next j
    
    'احذف البيانات من ذاكرة الكمبيوتر
    rst.Close: Set rst = Nothing
    rstSUB.Close: Set rstSUB = Nothing

End Sub

الكود ممتاز

لكني اريد عدم حذف السجلات بالجدول Tabl_bus اذا كانت موجوده

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

ما أريده عند ادخال عدد المقاعد والنقر على زر الأمر اعمل السجلات قراءة الجدول Tabl_bus هل يحتوي على سجلات

بنفس القيم المدخله

اذا كان لا يدخل سجلات جديده

اذا كان نعم يوجد سجلات يقارنها برقم عدد المقاعد هل هي أكبر أم أصغر

اذا كانت اصغر يضيف السجلات المتبقيه

أذا كانت السجلات بالجدول Tabl_bus أكبر من الرقم المدخل يقوم بحذف السجلات الزائده حسب رقم Auto_ id من الأكبر إلى الأصغر

أرجو أن يكون شرح المطلوب واضح

806.1.AAddseat.rar

**jjafferr** · ديسمبر 27, 2017

السلام عليكم اخوي كاسر

خليك معاي لوسمحت ، اجرب شيء وارجع لك :smile:

جعفر

**kaser906** · ديسمبر 27, 2017

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

بانتظارك استاذي الكريم :rol:

**jjafferr** · ديسمبر 27, 2017

في 12/26/2017 at 13:36, kaser906 said:

يقوم بحذف السجلات الزائده حسب رقم Auto_ id من الأكبر إلى الأصغر

قصدك Auto_Chair_ID ؟

**kaser906** · ديسمبر 27, 2017

نعم استاذ

**jjafferr** · ديسمبر 27, 2017

يعني مثلا:

اذا كان عندنا في جدول الباصات 40 سجل:

اذا عدد مقاعد النموذج الفرعي = 30 ، اذن نقوم بحذف Auto_Chair_ID الاكبر الى الاصغر ، مثلا 31-40
اذا عدد مقاعد النموذج الفرعي = 50 ، اذن نقوم بإضافةسجلات ، 41-50

مع الاخذ بعين لاعتبار بأن الرقم الذي يتم حذفة من Auto_Chair_ID لا يمكن الحصول عليه مرة اخرى.

صح هذا المطلوب؟

**kaser906** · ديسمبر 27, 2017

1 دقيقه مضت, jjafferr said:

يعني مثلا:

اذا كان عندنا في جدول الباصات 40 سجل:

اذا عدد مقاعد النموذج الفرعي = 30 ، اذن نقوم بحذف Auto_Chair_ID الاكبر الى الاصغر ، مثلا 31-40

اذا عدد مقاعد النموذج الفرعي = 50 ، اذن نقوم بإضافةسجلات ، 41-50

مع الاخذ بعين لاعتبار بأن الرقم الذي يتم حذفة من Auto_Chair_ID لا يمكن الحصول عليه مرة اخرى.

صح هذا المطلوب؟

بالضبط استاذ جعفر هو هذا المطلوب

**jjafferr** · ديسمبر 27, 2017

وهكذا اصبح الكود ، ورجاء تجربته

Private Sub cmd_Do_Records_Click()

    Dim rst As DAO.Recordset
    Dim rstSUB As DAO.Recordset
     
    
    'نقرأ بيانات النموذج الفرعي
    Set rstSUB = Me.Forme_Sub_Itinerary.Form.RecordsetClone
    rstSUB.MoveLast: rstSUB.MoveFirst
    RCsub = rstSUB.RecordCount
    
    'نقرأ كل سجل من سجلات النموذج الفرعي
    For j = 1 To RCsub
               
        'اذا يوجد علامة صح في حقل "اعمل التغييرات" فقم بحذف السجلات السابقة لهذا الخط ، واعمله من جديد
        If rstSUB!Do_Changes = -1 Then
        
    
            'نجهز الجدول لإدخال/حذف بيانات رقم المقعد
            mySQL = "SELECT Auto_Chair_ID AS Auto, Tabl_bus.*"
            mySQL = mySQL & " FROM Tabl_bus"
            mySQL = mySQL & " WHERE Num_Itinerary_ID=" & rstSUB!Auto_ID
            mySQL = mySQL & " AND Num_Itinerary=" & rstSUB!Num_Itinerary
            mySQL = mySQL & " AND Num_rihla=" & rstSUB!Num_rihla
            mySQL = mySQL & " ORDER by Auto_Chair_ID DESC"
            'Debug.Print mySQL
            
            Set rst = CurrentDb.OpenRecordset(mySQL)
            rst.MoveLast: rst.MoveFirst
            RC = rst.RecordCount
    
            If RC > rstSUB!Number_seats Then
                        
                
                'نحذف سجلات رقم المقعد من الجدول
                For i = rstSUB!Number_seats + 1 To RC
                    rst.Delete
                    rst.MoveNext
                Next i
            
           Else
            
                'نضيف سجلات رقم المقعد في الجدول
                For i = RC + 1 To rstSUB!Number_seats
                    rst.addnew
                        rst!Num_Itinerary_ID = rstSUB!Auto_ID
                        rst!Num_Itinerary = rstSUB!Num_Itinerary
                        rst!Num_rihla = rstSUB!Num_rihla
                        rst![Chair_ No] = i
                    rst.Update
                Next i
            
            End If
            
            'نقوم بتغيير حقل "اعمل التغييرات" ونزيل الصح منها
            rstSUB.Edit
                rstSUB!Do_Changes = 0
            rstSUB.Update
            
            GoTo Exit_cmd_Do_Records_Click
            
        End If 'rstSUB
        rstSUB.MoveNext
    Next j
    
Exit_cmd_Do_Records_Click:

    'احذف البيانات من ذاكرة الكمبيوتر
    rst.Close: Set rst = Nothing
    rstSUB.Close: Set rstSUB = Nothing

End Sub

.

جعفر

806.2.AAddseat.accdb.zip

**kaser906** · ديسمبر 27, 2017

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

وهكذا اصبح الكود ، ورجاء تجربته


Private Sub cmd_Do_Records_Click()

    Dim rst As DAO.Recordset
    Dim rstSUB As DAO.Recordset
     
    
    'نقرأ بيانات النموذج الفرعي
    Set rstSUB = Me.Forme_Sub_Itinerary.Form.RecordsetClone
    rstSUB.MoveLast: rstSUB.MoveFirst
    RCsub = rstSUB.RecordCount
    
    'نقرأ كل سجل من سجلات النموذج الفرعي
    For j = 1 To RCsub
               
        'اذا يوجد علامة صح في حقل "اعمل التغييرات" فقم بحذف السجلات السابقة لهذا الخط ، واعمله من جديد
        If rstSUB!Do_Changes = -1 Then
        
    
            'نجهز الجدول لإدخال/حذف بيانات رقم المقعد
            mySQL = "SELECT Auto_Chair_ID AS Auto, Tabl_bus.*"
            mySQL = mySQL & " FROM Tabl_bus"
            mySQL = mySQL & " WHERE Num_Itinerary_ID=" & rstSUB!Auto_ID
            mySQL = mySQL & " AND Num_Itinerary=" & rstSUB!Num_Itinerary
            mySQL = mySQL & " AND Num_rihla=" & rstSUB!Num_rihla
            mySQL = mySQL & " ORDER by Auto_Chair_ID DESC"
            'Debug.Print mySQL
            
            Set rst = CurrentDb.OpenRecordset(mySQL)
            rst.MoveLast: rst.MoveFirst
            RC = rst.RecordCount
    
            If RC > rstSUB!Number_seats Then
                        
                
                'نحذف سجلات رقم المقعد من الجدول
                For i = rstSUB!Number_seats + 1 To RC
                    rst.Delete
                    rst.MoveNext
                Next i
            
           Else
            
                'نضيف سجلات رقم المقعد في الجدول
                For i = RC + 1 To rstSUB!Number_seats
                    rst.addnew
                        rst!Num_Itinerary_ID = rstSUB!Auto_ID
                        rst!Num_Itinerary = rstSUB!Num_Itinerary
                        rst!Num_rihla = rstSUB!Num_rihla
                        rst![Chair_ No] = i
                    rst.Update
                Next i
            
            End If
            
            'نقوم بتغيير حقل "اعمل التغييرات" ونزيل الصح منها
            rstSUB.Edit
                rstSUB!Do_Changes = 0
            rstSUB.Update
            
            GoTo Exit_cmd_Do_Records_Click
            
        End If 'rstSUB
        rstSUB.MoveNext
    Next j
    
Exit_cmd_Do_Records_Click:

    'احذف البيانات من ذاكرة الكمبيوتر
    rst.Close: Set rst = Nothing
    rstSUB.Close: Set rstSUB = Nothing

End Sub

.

جعفر

806.2.AAddseat.accdb.zip

الله يعطيك العافية استاذي الكريم

عند التعديل على السجلات يعمل الكود بشكل ممتاز

لكن تظهر مشكلة عند إضافة سجل جديد

انظر الصورة

**jjafferr** · ديسمبر 27, 2017

نصطاد هذا الخطأ ، جرب

Private Sub cmd_Do_Records_Click()
On Error GoTo err_cmd_Do_Records_Click

    Dim rst As DAO.Recordset
    Dim rstSUB As DAO.Recordset
     
    
    'نقرأ بيانات النموذج الفرعي
    Set rstSUB = Me.Forme_Sub_Itinerary.Form.RecordsetClone
    rstSUB.MoveLast: rstSUB.MoveFirst
    RCsub = rstSUB.RecordCount
    
    'نقرأ كل سجل من سجلات النموذج الفرعي
    For j = 1 To RCsub
               
        'اذا يوجد علامة صح في حقل "اعمل التغييرات" فقم بحذف السجلات السابقة لهذا الخط ، واعمله من جديد
        If rstSUB!Do_Changes = -1 Then
        
    
            'نجهز الجدول لإدخال/حذف بيانات رقم المقعد
            mySQL = "SELECT Auto_Chair_ID AS Auto, Tabl_bus.*"
            mySQL = mySQL & " FROM Tabl_bus"
            mySQL = mySQL & " WHERE Num_Itinerary_ID=" & rstSUB!Auto_ID
            mySQL = mySQL & " AND Num_Itinerary=" & rstSUB!Num_Itinerary
            mySQL = mySQL & " AND Num_rihla=" & rstSUB!Num_rihla
            mySQL = mySQL & " ORDER by Auto_Chair_ID DESC"
            'Debug.Print mySQL
            
            Set rst = CurrentDb.OpenRecordset(mySQL)
            rst.MoveLast: rst.MoveFirst
            RC = rst.RecordCount
    
            If RC > rstSUB!Number_seats Then
                        
                
                'نحذف سجلات رقم المقعد من الجدول
                For i = rstSUB!Number_seats + 1 To RC
                    rst.Delete
                    rst.MoveNext
                Next i
            
           Else
            
                'نضيف سجلات رقم المقعد في الجدول
                For i = RC + 1 To rstSUB!Number_seats
                    rst.addnew
                        rst!Num_Itinerary_ID = rstSUB!Auto_ID
                        rst!Num_Itinerary = rstSUB!Num_Itinerary
                        rst!Num_rihla = rstSUB!Num_rihla
                        rst![Chair_ No] = i
                    rst.Update
                Next i
            
            End If
            
            'نقوم بتغيير حقل "اعمل التغييرات" ونزيل الصح منها
            rstSUB.Edit
                rstSUB!Do_Changes = 0
            rstSUB.Update
            
            GoTo Exit_cmd_Do_Records_Click
            
        End If 'rstSUB
        rstSUB.MoveNext
    Next j
    
Exit_cmd_Do_Records_Click:

    'احذف البيانات من ذاكرة الكمبيوتر
    rst.Close: Set rst = Nothing
    rstSUB.Close: Set rstSUB = Nothing

Exit Sub
err_cmd_Do_Records_Click:

    If Err.Number = 3021 Then
        Resume Next
    Else
        MsgBox Err.Number & vbCrLf & Err.Description
    End If
    
End Sub

جعفر

**kaser906** · ديسمبر 27, 2017

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

نصطاد هذا الخطأ ، جرب

:wavetowel: :clapping:

ممتاز

مشكور ورحم الله والديك

هذا هو المطلوب

**jjafferr** · ديسمبر 27, 2017

ووالديك ، وتصبح على خير :smile:

تسجيل الدخول

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

الردود الموصى بها

kaser906

jjafferr

kaser906

jjafferr

kaser906

jjafferr

kaser906

jjafferr

kaser906

jjafferr

kaser906

jjafferr

Join the conversation

تصفح هذا الموضوع مؤخراً 0 اعضاء متواجدين الان

تصفح الموقع

تصفح جديد الموقع

Support

Important Information