مساعدة في تعديل كود عدم تكرار السيريل نمبر

[samisalim]

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

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

If SERIAL = Me.CMBSERIAL.Column(0) And Not Me.NewRecord Then

Me.CMBSERIAL.Undo
Me.Undo
Exit Sub
End If

If SERIAL = Me.CMBSERIAL.Column(0) And Not Me.NewRecord Then
Me.CMBSERIAL.Undo
Me.Undo
MsgBox "هذا الجهاز مسجل مسبقاً", vbInformation, "تنبيه التكرار"
DoCmd.FindRecord cmbrecord
Exit Sub
End If

officena.rar

[kanory]

جرب هذا الكود بدل الموجود لديك ...

If Me.CMBSERIAL.Column(0) = DLookup("IDD", "EMPDEV", "[IDD] = '" & Me.CMBSERIAL.Column(0) & "'") Then
        Me.CMBSERIAL.Undo
        Me.Undo
        MsgBox "هذا الجهاز مسجل مسبقاً", vbInformation, "تنبيه التكرار"
        Exit Sub

Else
        MsgBox "تم"
End If

 

[samisalim]

14 ساعات مضت, kanory said:

جرب هذا الكود بدل الموجود لديك ...

If Me.CMBSERIAL.Column(0) = DLookup("IDD", "EMPDEV", "[IDD] = '" & Me.CMBSERIAL.Column(0) & "'") Then
        Me.CMBSERIAL.Undo
        Me.Undo
        MsgBox "هذا الجهاز مسجل مسبقاً", vbInformation, "تنبيه التكرار"
        Exit Sub

Else
        MsgBox "تم"
End If

 

ماشاء الله عليك أخي الغاليkanory

الكود شغال 100% بارك الله فيك والله يعطيك الصحة والعافية

[samisalim]

أخي KANORY

أردت تطبيق الكود على كمبو الاسماء لكن تظهر لي رسالة ارفق لكم صورة المشكلة

هذا الكود

If Me.CMBNAME.Column(0) = DLookup("IDE", "EMPDEV", "[IDE] = '" & Me.CMBNAME.Column(0) & "'") Then
       Me.CMBNAME.Undo
        Me.Undo
       MsgBox "هذا الاسم مسجل مسبقاً", vbInformation, "تنبيه التكرار"
        Exit Sub

Else
       MsgBox "تم"
End If

 

[kanory]

9 ساعات مضت, samisalim said:

أخي KANORY

أردت تطبيق الكود على كمبو الاسماء لكن تظهر لي رسالة ارفق لكم صورة المشكلة

هذا الكود

If Me.CMBNAME.Column(0) = DLookup("IDE", "EMPDEV", "[IDE] = '" & Me.CMBNAME.Column(0) & "'") Then
       Me.CMBNAME.Undo
        Me.Undo
       MsgBox "هذا الاسم مسجل مسبقاً", vbInformation, "تنبيه التكرار"
        Exit Sub

Else
       MsgBox "تم"
End If

 

جرب هذا الكود .....

If Me.IDE = DLookup("IDE", "EMPDEV", "[IDE] = " & Me.IDE) Then

        Me.CMBSERIAL.Undo
        Me.Undo
        MsgBox "هذا الاسم مسجل مسبقا", vbInformation, "تنبيه تكرار"
        Exit Sub
Else
        MsgBox "تم"
End If

 

[samisalim]

أشكرك أخي الكود اشتغل معي100% بعدني اتعبك معي هل ممكن تشرح لي الكود الاول والثاني

If SERIAL = Me.CMBSERIAL.Column(0) And Not Me.NewRecord Then

Me.CMBSERIAL.Undo
Me.Undo
Exit Sub
End If

If SERIAL = Me.CMBSERIAL.Column(0) And Not Me.NewRecord Then
Me.CMBSERIAL.Undo
Me.Undo
MsgBox "هذا الجهاز مسجل مسبقاً", vbInformation, "تنبيه التكرار"
DoCmd.FindRecord cmbrecord
Exit Sub
End If

If Me.IDE = DLookup("IDE", "EMPDEV", "[IDE] = " & Me.IDE) Then

        Me.CMBSERIAL.Undo
        Me.Undo
        MsgBox "هذا الاسم مسجل مسبقا", vbInformation, "تنبيه تكرار"
        Exit Sub
Else
        MsgBox "تم"
End If

لاني مبتدي في الاكسس وجزاك الله خيراً

[kanory]

26 دقائق مضت, samisalim said:

أشكرك أخي الكود اشتغل معي100% بعدني اتعبك معي هل ممكن تشرح لي الكود الاول والثاني

If SERIAL = Me.CMBSERIAL.Column(0) And Not Me.NewRecord Then

Me.CMBSERIAL.Undo
Me.Undo
Exit Sub
End If

If SERIAL = Me.CMBSERIAL.Column(0) And Not Me.NewRecord Then
Me.CMBSERIAL.Undo
Me.Undo
MsgBox "هذا الجهاز مسجل مسبقاً", vbInformation, "تنبيه التكرار"
DoCmd.FindRecord cmbrecord
Exit Sub
End If

 

بالنسبة للكود الاول لم يعمل معك .. لأنك SIRIAL  غير موجود في النموذج لديك

 

28 دقائق مضت, samisalim said:

أشكرك أخي الكود اشتغل معي100% بعدني اتعبك معي هل ممكن تشرح لي الكود الاول والثاني

If Me.IDE = DLookup("IDE", "EMPDEV", "[IDE] = " & Me.IDE) Then

        Me.CMBSERIAL.Undo
        Me.Undo
        MsgBox "هذا الاسم مسجل مسبقا", vbInformation, "تنبيه تكرار"
        Exit Sub
Else
        MsgBox "تم"
End If

 

في الكود الثاني استخدمنا DLOOKUP للبحث عن القيمة الموجودة في مربع النص IDE في جدول EMPDEV في الحقل IDE  عندما قيمة الحقل IDE  يساوي القيمة الموجودة في مربع النص IDE عند وجود القيمة في الجدول يقوم الكود بمسح الحقول واعطاء الرسالة بوجود السجل ELSE في حالة عدم وجود القيمة في الجدول يتمم حفظ السجل 

انصحك بالبحث في المنتدى شرح مستفيض عن دالة DLOOKUP

ارجو اني وفقت للشرح ...... لأني ضعيف جدا في الشرح .... 

[samisalim]

شرح مفهوم أخي شكرا جزيلا

تم تعديل يوليو 6, 2020 بواسطه samisalim