منع التكرار في الإدخالات بمجرد إدخال حقل المفتاح

[رامي]

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

فاريد لحظة ادخال رقم ال key رسالة تمنع ادخال الحقل

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

شش

[فتى الوادي]

السلام عليكم .. ضع هذا الكود بعد التحديث لحقل الرقم ..

على أفتراض أن اسم الحقل txt1 واسم النموذج form1 والجدول tb1

If (Eval("DLookUp(""[txt1]"",""[tb1]"",""[txt1] =form![txt1]"") Is Not Null")) Then
        Beep
MsgBox "عفواً سبق أدخال الرقم"

Me.Undo
Cancel = True
Else
end if

[أمجد جمالي]

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

اعتقد أخي الكريم بأن هذه الطريقة اكثر احترافاً

فهذه الطريقة تعرض رسالة تفيد بأن هناك إزدواجية في قاعدة البيانات كما تعرض اسم صاحب الرقم بالعربي والانجليزي

ومن يجد صعوبة في فهم الشفرة يكتبلي وانا برفق مثال

تحياتي للجميع

ابو نادر

Private Sub EmNo_AfterUpdate()

On Error GoTo Err_Form_EmNo

    Dim CnnLocal As New ADODB.Connection
    Dim RstSrchforDublc As New ADODB.Recordset
    
    Const ConErrNoValue = "3021"
    Const ConErrInvalidUseOfNull = "94"
    
    Set CnnLocal = CurrentProject.Connection
    RstSrchforDublc.Open "TblDataEmployee", CnnLocal, adOpenStatic
    RstSrchforDublc.Find "EmNo LIKE '" & EmNo & "'"
    StrEmpNameEng = RstSrchforDublc!EmName
    StrEmpNameArb = RstSrchforDublc!EEmName
    Result = RstSrchforDublc!EmNo
    RstSrchforDublc.Close
    
    If Result = EmNo Then
    DisplayMessageCritical "There's Duplicate Employee No. " & Result & " For" & vbCrLf & "" & vbCrLf & _
    "Employee :" & StrEmpNameArb & "" & vbCrLf & "Employee :" & StrEmpNameEng & "" & vbCrLf & "" & vbCrLf & _
    "In Administrative Personal DataBase.", "Duplicate Employee No."
    End If
    
Exit_form_EmNo:
    Exit Sub
    
Err_Form_EmNo:
    
    If Err.Number = ConErrInvalidUseOfNull Then
        Resume Next
    ElseIf Err.Number = ConErrNoValue Then
        RstSrchforDublc.Close
    Else
        RstSrchforDublc.Close
        DisplayMessageCritical Err.Description, "Error Message"
    End If
    Resume Exit_form_EmNo

End Sub

[أمجد جمالي]

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

تفضل هذا هو المثال

تحياتي

ابو نادر

DuplicateEmployeeNo.zip

[ashraf]

هذا الكود قريب لكود الأخ أمجد لكن أعتقد أنه ابسط شوية وهو تعديل لنفس كود الأخ فتى الوادي ويظهر ايضا صاحب الرقم

 If (Eval("DLookUp(""[id] "",""[tbl_data]"",""[id]=form![id]"") Is Not Null")) Then

  MsgBox "تم تسجيل هــذا الرقــم  من قبــــل .... !!!!" & vbCrLf _
& "واسمه : " & DLookup("name", "tbl_data", "[id]=" & Forms![frm_data]![id]), vbExclamation, "رقم عميل مكرر "

        DoCmd.CancelEvent
    
    SendKeys "{f2}", False
  End If

تم تعديل أكتوبر 27, 2004 بواسطه ashraf

[رامي]

اخي العزيز امجد

عندما حملت الملف وادخلت رقما اعطى رسالة تقول : غير مسموح بالعملية اذا كان الكائن مغلق !!!!

ثم يفتح الشاشة التي بها الكود ويضىء لون اصفر عند الكود التالي :

RstSrchforDublc.Close

[mshishan2003]

السلام عليكم جميعاً

السيد امجد

لقد اضفت الكود الى برنامجي وهو برنامج ادخال الفواتير وقمت بتغير اسماء الحقول حسب الحقول في الجدول ويعطيني رسالة خطأ ويقوم بتظليل الجملة

DisplayMessageCritical

والملف موجود يمكن ارساله لك بالبريد او باي شكل اخر

وهذا هو عنواني. ارجوا المساعدة وشكراً

mshishan2003@yahoo.com

[أمجد جمالي]

ضع هذا الكود في وحدة نمطية جديدة

Public Sub DisplayMessageCritical(StrMessage, Optional ConAppName As String)
    
    MsgBox StrMessage, vbCritical, ConAppName
    
End Sub

راجع المثال المرفق سوف تجد وحدة نمطية بعنوان Messages

واتمنى لك التوفيق

ابو نادر

[mshishan2003]

اشكرك اخ ابو نادر

واسف لاني لم انتبه الى الوحدات النمطية ولكن المشكلة الان في اغلاق

RstSrchforDublc.Close في جملة ELSE الاخيرة

وهذا هو الكود كما كتبته

اذا كان بالامكان مراجعته ولك جزيل الشكر

Option Compare Database

Option Explicit

Dim CnnLocal As New ADODB.Connection

Dim RstSrchforDublc As New ADODB.Recordset[/align]Const ConErrNoValue = "3021"

Const ConErrInvalidUseOfNull = "94"

Dim StrNameEng As String

Dim IntInvoice_No As Integer

Private Sub Invoice_No_Exit(Cancel As Integer)

On Error GoTo Err_Form_Invoice_No

Set CnnLocal = CurrentProject.Connection

RstSrchforDublc.Open "TblDataEmployee", CnnLocal, adOpenStatic

RstSrchforDublc.Find "Invoice_No LIKE '" & Invoice_No & "'"

'StrNameEng = RstSrchforDublc!Name

IntInvoice_No = RstSrchforDublc!Invoice_No

RstSrchforDublc.Close

If IntInvoice_No = Invoice_No Then

DisplayMessageCritical "There's Duplicate Employee No. " & IntInvoice_No & " For" & vbCrLf & "" & vbCrLf & _

"Employee :" & StrNameEng & "" & vbCrLf & "" & vbCrLf & _

"In Administrative Personal DataBase.", "Duplicate Employee No."

End If

Exit_form_Invoice_No:

Exit Sub

Err_Form_Invoice_No:

If Err.Number = ConErrInvalidUseOfNull Then

Resume Next

ElseIf Err.Number = ConErrNoValue Then

RstSrchforDublc.Close

Else

RstSrchforDublc.Close

DisplayMessageCritical Err.Description, "Error Message"

End If

Resume Exit_form_Invoice_No

End Sub[/align]

[أمجد جمالي]

السلام عليكم

حمل الملف الى المنتدى او

ارسله الى ايميلي من بعد ضغطه

الى ajamali@acts-alsarh.com

تحياتي لك

[mshishan2003]

الاخ ابو نادر

تم ارسال الملف على بريدك

وشكراً

[أمجد جمالي]

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

تم تعديل المثال وهو يعمل الأن من دون مشاكل

والأخطاء هي أخي الكريم

RstSrchforDublc.Open "TblDataEmployee", CnnLocal, adOpenStatic

اسم الجدول عندك الذي تطلب الإتصال به هو Invoices وليس TblDataEmployee

تجنب المسافات بين كلمتين عند تسمية الخانات سواء في الجداول او في النماذج

ايضاً تجنب تسمية الحقول باللغة العربية

مع تمنياتي لك بالتوفيق

اخوك امجد (ابو نادر)

هذا هو المثال من بعد التعديل

invoices.rar

[mshishan2003]

الله يبارك فيك ويكثر امثالك ويبعتلك ذرية صالحة ويعطيك الفردوس الاعلى

وشكراً جزيلاً

[أمجد جمالي]

الله يعافيك

ومن تمك لباب السماء