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

[qathi]

ألتزاماً بقوانين المنتدى وحتى لا اطلب في الموضوع السابق

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

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

If DCount("SuID", "[Contacts_T]", "[SuID]= " & Me.SupplierID) > 0 Then

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

[AlwaZeeR]

Private Function IsDplcateRec() As Boolean
    IsDplcateRec = False
    
    If IsNull(DLookup("SuID", "Contacts_T", "SuID=" & Me.SupplierID)) = False Then
    IsDplcateRec = True
    Else
    CurrentDb.Execute "INSERT into Contacts_T([SuID]) VALUES (" & SupplierID & " )"
    End If
    
End Function

Private Sub cmd_Click()
  On Error Resume Next
  
 Dim Lst As String
 Lst = DLast("SuID", "Contacts_T") + 1
 
    If IsDplcateRec Then
        MsgBox _
        " الرقم المدخل موجود في الجدول وهو : ( " & [SupplierID] & " )"
    CurrentDb.Execute "INSERT into Contacts_T([SuID]) VALUES (" & Lst & " )"
        MsgBox _
        "تم اضافة سجل جديد برقم : ( " & [Lst] & " )"
   End If

End Sub

الكود يقوم بـ

يفحص اذا كان الرقم المدخل موجود يخبرك انه موجود

وسيتم إضافة سجل باخر رقم مووجود في الجدول +1

بخصوص التحديث في جدولين

فقط استخدم الامر 

    CurrentDb.Execute "INSERT into Contacts_T([SuID]) VALUES (" & Lst & " )"

مع استبدال المتغيرات حسب حاجتك

اليك ملف تجريبي

=

 

fix-07-07-2019.accdb

تم تعديل يوليو 7, 2019 بواسطه AlwaZeeR
Forget The Attach

[qathi]

أخي الوزير @AlwaZeeR أشكرك على جهدك وعملك الرائع

يعمل بشكل جيد أذا كان حقل منفرد فقط

لكن لا أعرف بخصوص أدراج أكثر من حقل يبدو أنه لم يفلح معي .. 

 

هذا مثال أتمنى منك التعديل علية

Database1.rar

[qathi]

للرفع ..

 

[AlwaZeeR]

حياك الله عزيزي

لكن لم افهم ماذا تقصد 

20 hours ago, qathi said:

لكن لا أعرف بخصوص أدراج أكثر من حقل يبدو أنه لم يفلح معي

 

[qathi]

 أخي الوزير @AlwaZeeR أرجو تطبيق عملك

في ٧‏/٧‏/٢٠١٩ at 10:09, AlwaZeeR said:

Private Function IsDplcateRec() As Boolean IsDplcateRec = False If IsNull(DLookup("SuID", "Contacts_T", "SuID=" & Me.SupplierID)) = False Then IsDplcateRec = True Else CurrentDb.Execute "INSERT into Contacts_T([SuID]) VALUES (" & SupplierID & " )" End If End Function Private Sub cmd_Click() On Error Resume Next Dim Lst As String Lst = DLast("SuID", "Contacts_T") + 1 If IsDplcateRec Then MsgBox _ " الرقم المدخل موجود في الجدول وهو : ( " & [SupplierID] & " )" CurrentDb.Execute "INSERT into Contacts_T([SuID]) VALUES (" & Lst & " )" MsgBox _ "تم اضافة سجل جديد برقم : ( " & [Lst] & " )" End If End Sub

في ملفي التالي

فيه محاولتي

Database1.rar

تم تعديل يوليو 8, 2019 بواسطه qathi

[qathi]

للرفع ..

هل يوجد من يساعد في تنفيذ الطلب في المثال التالي

Pro1.accdb

[qathi]

للرفع ....