اذهب الي المحتوي
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
Custom Search

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

kaser906

بواسطه kaser906
في قسم الأكسيس Access

 مشاركة

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

kaser906

kaser906

قام بنشر
قام بنشر

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

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

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

 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

jjafferr

قام بنشر
قام بنشر

يعني مثلا:

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

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

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

 

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

رابط هذا التعليق
شارك
kaser906

kaser906

قام بنشر
  • الكاتب
قام بنشر
1 دقيقه مضت, jjafferr said:

يعني مثلا:

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

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

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

 

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

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

رابط هذا التعليق
شارك
jjafferr

jjafferr

قام بنشر
قام بنشر

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

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

  • Like 1
رابط هذا التعليق
شارك
kaser906

kaser906

قام بنشر
  • الكاتب
قام بنشر
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

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

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

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

انظر الصورة

151441005184071.png

رابط هذا التعليق
شارك
jjafferr

jjafferr

قام بنشر
قام بنشر

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

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

 

جعفر

  • Like 2
رابط هذا التعليق
شارك

من فضلك سجل دخول لتتمكن من التعليق

ستتمكن من اضافه تعليقات بعد التسجيل



سجل دخولك الان
 مشاركة
الذهاب الي قائمه المواضيع

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

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information

  I accept