ابو جودي

تم حل المشكلة

Check Input Exist.accdbتم تحديث المرفق فى رأس الموضوع تاربخ تحديث المرفق السبت 22 رمضان 1443 هـ , 23 -أبريل -2022 م تم إضافة وظيقة للتعرف نوع البيانات المستخدم فى الحقل داخل الجدول

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

وعليكم السلام ورحمة الله تعالى وبركاته اعتذر جدا جدا جدا عن التأخير بسم الله ما شاء الله تبارك الله الله اكبر لو استطيع وضع اكثر من اعجاب واحد لفعلت الفكرة تستحق مليون اعجاب واكثر ويسرنى اليوم قبول هذه الهدية الرمضانية المتميزة و الرائعة و القيمة ممكن نعمل فكرة تانى بدلا من موضوع الاستيراد بس مش راح اقول لك عليها الان كل عام وانتم بخير يا باش مهندس @Moosak انتم وكل اساتذتى واخوانى الكرام كل عام وانتم الى الله اقرب وعلى طاعته ادوم ولفعل الخيرات اسبق و لسنة النبى الزم ولحب اتباعه اصدق ومن الجنة ادنى واقرب وعن النار ابعد . اسال الله تعالى الرحمة والعفو والغفران لكم و لكل المسلمين و لوالديكم و والداى برحمتك التي وسعت كل شيء . اللهم ان ابائنا قد احسنوا الينا منذ يوم ولادتنا اللهم وبحق هذا الاحسان ارحمهما و اغفر لهما برحمتك التى وسعت كل شيء . اللهم ارحم من فى بطن الارض من ابائنا و استرهم يوم العرض يارب العالمين يا رب انت خلقتهم وانت اخذتهم وانت الرحيم فليس غيرك ارحم بهم اللهم ارحمهم و اغفر لهم اكرم نزلهم و وسع مدخلهم اللهم اجعل قبورهم روضه من رياض الجنة واجمعنا بهم في جنة النعيم برحمتك يا ارحم الراحمين . ارحم يارب من مات منهم بالدنيا ولم يمت في قلوبنا اللهم ارحمه فهو اغلى من فقدنا واسكنه فسيح جناتك يا ارحم الراحمين. اللهم من بقى منهم فى هذه الدنيا بارك لنا يارب فى اعمارهم وارزقهم ثوب العافية وحبب الايمان الى قلوبهم وتقبل اعمالهم وارزقنا برهم وارض عنهم يارب واجعلهم راضين عنا يارب العالمين واحسن يارب خاتمتنا وخاتمتهم. اللهم امين امين امين 🤲🏻

هو كلام معاليك صح جدا جدا جدا طبعا يا أفندم بس جرب الكود وانت تعرف الفرق اولا الوقت يعمل على نظام 24 ساعة بإضافة علامة الـ سالب ( - ) يسار الوقت عداد الوقت يعمل تنازليا وبدون اى مشاكل وبدون الاعتماد على مربع النص t1 الدال على الوقت الحالى اى يمكنك ترك t1 يعمل على نظام الـ 12 ساعة و t2 يعمل بالعد التنازلى على نظام الـ 24 ساعة وبما اننا دخلنا لمحرر الأكود برجلينا واشتغلنا منه لاننا مضطرين لذلك بوضع الكود فى حدث الوقت ليعمل العد التنازلى خلى كل شئ من داخل المحرر يعنى علشان لو مستقبلا حب يعدل شئ ما يلفلف حوالين نفسه

ضع الوظيفة الاتية فى وحدة نمطية Option Compare Database Option Explicit #If VBA7 Or Win64 Then Public Declare PtrSafe Function apiGetSystemMenu Lib "user32" Alias "GetSystemMenu" (ByVal hwnd As Long, ByVal flag As Long) As Long Public Declare PtrSafe Function apiEnableMenuItem Lib "user32" Alias "EnableMenuItem" (ByVal hMenu As Long, ByVal wIDEnableMenuItem As Long, ByVal wEnable As Long) As Long #Else Public Declare Function apiEnableMenuItem Lib "user32" Alias "EnableMenuItem" (ByVal hMenu As Long, ByVal wIDEnableMenuItem As Long, ByVal wEnable As Long) As Long Public Declare Function apiGetSystemMenu Lib "user32" Alias "GetSystemMenu" (ByVal hWnd As Long, ByVal flag As Long) As Long #End If Const MF_BYCOMMAND = &H0& Const MF_DISABLED = &H2& Const MF_ENABLED = &H0& Const MF_GRAYED = &H1& Const SC_CLOSE = &HF060& Const SWP_NOSIZE = &H1 Const SWP_NOZORDER = &H4 Const SWP_NOMOVE = &H2 Const SWP_FRAMECHANGED = &H20 Const WS_MINIMIZEBOX = &H20000 Const WS_MAXIMIZEBOX = &H10000 Const WS_SYSMENU = &H80000 Public Function EnableDisableControlBoxX(bEnable As Boolean, Optional ByVal lhWndTarget As Long = 0) As Long On Error GoTo Err_EnableDisableControlBoxX Dim lhWndMenu As Long Dim lReturnVal As Long Dim lAction As Long lhWndMenu = apiGetSystemMenu(IIf(lhWndTarget = 0, Application.hWndAccessApp, lhWndTarget), False) If lhWndMenu <> 0 Then If bEnable Then lAction = MF_BYCOMMAND Or MF_ENABLED Else lAction = MF_BYCOMMAND Or MF_DISABLED Or MF_GRAYED End If lReturnVal = apiEnableMenuItem(lhWndMenu, SC_CLOSE, lAction) End If EnableDisableControlBoxX = lReturnVal Exit_EnableDisableControlBoxX: Exit Function Err_EnableDisableControlBoxX: MsgBox "Error:" & Err.Number & vbCrLf & "Description: " & Err.Description Resume Exit_EnableDisableControlBoxX End Function ويمكنك عدم تفعيل زر الاغلاق من خلال EnableDisableControlBoxX False ويمكنك الرجوع للوضع الاصلى بإعادة فاعلية زر الاغلاق من EnableDisableControlBoxX True

بسيطة برضو اتفضل يا سيدى t2= "- " & Format(DateAdd("N", 1, Format(#11:59:59 PM# - Time(), "HH:mm:ss")), "HH:mm:ss")

مش سامع حد بيرد يعنى

طيب الحل ببساطة يكون t2 = DateAdd("N", 1, Format(#11:59:59 PM# - Time(), "HH:MM:SS"))

بس فى فرق دقيقه ماليش دعوة اناا عاوز الدقيقة دى بقه

وهذا ان شاء الله يلبى طلبك

انطر هذا الموضوع لضيق وقتى الان ان شار الله تجد فيه ضالتك

الوقت المتبقى على شو ما فهمت عليك والبخور ما بينفع برمضان الله يرضى عنيك وضح

طيب يا استاذ @RaDwAn00 ارسلت اليكم رسالة خاصة وانتظر الجواب

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

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

طب 9/10 علشان اول واحد مجاوب وعلشان العيش والملح 😅 حلو عصف الاذهان ويكفيك شرف المحاولة غلطة الشاطر بـ 1000 كده انا 7/10 😭

طيب يا استاذ @Moosak ,واستاذ @abouelhassan من فضلكم تجربة المرفق فى رأس الموضوع مرة أخرى تم تحديث المرفق السبت 22 رمضان 1443 هـ , 23 -أبريل -2022 م تم إضافة وظيقة للتعرف نوع البيانات المستخدم فى الحقل داخل الجدول والباش مهندس @Eng.Qassim ممكن حضرتك توضح قصدك من أو تفضل وتكرم علينا بالتعديل المناسب كما تراه ربما كانت نظرتكم وفكرتم افضل بكثير

طيب ممكن نضيف السطر الاتى للكود وتم التعديل فى المرفق الرئيسي If Len(strObjectContainFieldValue) = 0 Or IsNull(strObjectContainFieldValue) Then Exit Function لكن لم افهم

اتفضل يا باش مهندس @Moosak

السلام عليكم ورحمة الله تعالى وبركاته احيانا نريد التأكد من وجود قيمة محددة فى حقل محدد داخل جدول محدد وذلك حتى نتأكد من عدم حدوث تكرار وطبعا كالعادة سوف اقدم لكم اليوم فكرتى المتواضعة فى هذا الشأن من خلال استخدام وظيفة عامة تعمل كروتين من خلال وحدة نمطية بحيث يتم اسناد القيم التى تخص كل من القيمة واسم الحقل واسم الجدول الى متغيرات عامة ليتم الفحص يعنى مثل ما سوينا من قبل مع المعرف الخاص البرمجى هنا فى هذا الموضوع '|-----------------------------------------------------------| '|---15/09/1443-------16/04/2022_____________________________| '|___www.officena.net________________________________________| '| | '| _ +-----------officena-----------+ _ | '| /o) | ||||| | (o\ | '| / / | @(~O^O~)@ | \ \ | '| ( (_ | _ ----oOo--Moh--oOo----- _ | _) ) | '| ((\ \) +/o)----------3ssam---------(o\+ (/ /)) | '| (\\\ \_/ / \ \_/ ///) | '| \ / \ / | '| \____/________Mohammed Essam________\____/ | '| 15/09/1443 | '| 16/04/2022 | '| | '|_____www.officena.net______________________________________| '|_____Thank you for visiting https://www.officena.net_______| '|-----------------------------------------------------------| '======Check Input Exist By Input Type======================================================================================================================================' ' ____ __ ____ ____ __ ____ ____ __ ____ ______ _______ _______ __ ______ _______ .__ __. ___ .__ __. _______ .___________. ' ' \ \ / \ / / \ \ / \ / / \ \ / \ / / / __ \ | ____|| ____|| | / || ____|| \ | | / \ | \ | | | ____|| | ' ' \ \/ \/ / \ \/ \/ / \ \/ \/ / | | | | | |__ | |__ | | | ,----'| |__ | \| | / ^ \ | \| | | |__ `---| |----` ' ' \ / \ / \ / | | | | | __| | __| | | | | | __| | . ` | / /_\ \ | . ` | | __| | | ' ' \ /\ / \ /\ / \ /\ / __| `--' | | | | | | | | `----.| |____ | |\ | / _____ \ __| |\ | | |____ | | ' ' \__/ \__/ \__/ \__/ \__/ \__/ (__)\______/ |__| |__| |__| \______||_______||__| \__| /__/ \__\ (__)__| \__| |_______| |__| ' ' ' '===========================================================================================================================================================================' Public Function CheckInputExist( _ ByRef strFieldName As String, _ ByRef strTableName As String, _ ByVal strObjectContainFieldValue) As Boolean On Error GoTo ErrorHandler Dim strFormName As Access.Form Dim stLinkCriteria As String Dim strMsgTitel As String Dim strMsgPrt1 As String Dim strMsgPrt2 As String Dim strErrMsgTitel As String Dim strErrMsg As String Set strFormName = Screen.ActiveForm strMsgPrt1 = ChrW("1578") & ChrW("1605") & ChrW("32") & ChrW("1575") & ChrW("1604") & ChrW("1593") & ChrW("1579") & ChrW("1608") & ChrW("1585") & ChrW("32") & ChrW("1593") & ChrW("1604") & ChrW("1609") & ChrW("32") & ChrW("46") & ChrW("46") & ChrW("13") & ChrW("10") & ChrW("40") & ChrW("160") strMsgPrt2 = ChrW("32") & ChrW("41") & ChrW("13") & ChrW("10") & ChrW("1587") & ChrW("1608") & ChrW("1601") & ChrW("32") & ChrW("1610") & ChrW("1578") & ChrW("1605") & ChrW("32") & ChrW("1575") & ChrW("1604") & ChrW("1575") & ChrW("1606") & ChrW("1578") & ChrW("1602") & ChrW("1575") & ChrW("1604") & ChrW("32") & ChrW("1575") & ChrW("1604") & ChrW("1609") & ChrW("32") & ChrW("1575") & ChrW("1604") & ChrW("1587") & ChrW("1580") & ChrW("1604") & ChrW("32") & ChrW("1575") & ChrW("1604") & ChrW("1575") & ChrW("1606") If Len(strObjectContainFieldValue) = 0 Or IsNull(strObjectContainFieldValue) Then Exit Function Select Case FieldTypeName(strFieldName, strTableName) Case Is = "Text": stLinkCriteria = strFieldName & "= '" & strObjectContainFieldValue & "'" Case Is = "Date/Time": stLinkCriteria = strFieldName & "= #" & Format(strObjectContainFieldValue, "dd/mm/yyyy") & "#" Case Is = "Long Integer": stLinkCriteria = strFieldName & "=" & strObjectContainFieldValue Case Is = "Integer": stLinkCriteria = strFieldName & "=" & strObjectContainFieldValue Case Is = "Byte": stLinkCriteria = strFieldName & "=" & strObjectContainFieldValue Case Is = "Single": stLinkCriteria = strFieldName & "=" & strObjectContainFieldValue Case Is = "Double": stLinkCriteria = strFieldName & "=" & strObjectContainFieldValue Case Is = "Decimal": stLinkCriteria = strFieldName & "=" & strObjectContainFieldValue End Select If DCount("*", strTableName, stLinkCriteria) > 0 Then MsgBox$ strMsgPrt1 & strObjectContainFieldValue & strMsgPrt2, vbExclamation + vbMsgBoxRight + vbMsgBoxRtlReading, "" strFormName.Undo strFormName.Recordset.FindFirst stLinkCriteria Else End If procDone: Exit Function ErrorHandler: strErrMsgTitel = ChrW("1582") & ChrW("1591") & ChrW("1571") & ChrW("32") & ChrW("1601") & ChrW("1609") & ChrW("32") & ChrW("1606") & ChrW("1608") & ChrW("1593") & ChrW("32") & ChrW("1575") & ChrW("1604") & ChrW("1576") & ChrW("1576") & ChrW("1610") & ChrW("1575") & ChrW("1606") & ChrW("1575") & ChrW("1578") strErrMsg = ChrW("1604") & ChrW("1602") & ChrW("1583") & ChrW("32") & ChrW("1581") & ChrW("1575") & ChrW("1608") & ChrW("1604") & ChrW("1578") & ChrW("32") & ChrW("1573") & _ ChrW("1583") & ChrW("1582") & ChrW("1575") & ChrW("1604") & ChrW("32") & ChrW("1606") & ChrW("1608") & ChrW("1593") & ChrW("32") & ChrW("1576") & ChrW("1610") & _ ChrW("1575") & ChrW("1606") & ChrW("1575") & ChrW("1578") & ChrW("32") & ChrW("1594") & ChrW("1610") & ChrW("1585") & ChrW("32") & ChrW("1589") & ChrW("1581") & _ ChrW("1610") & ChrW("1581") & ChrW("46") & ChrW("46") & ChrW("46") & ChrW("13") & ChrW("10") & ChrW("32") & ChrW("1606") & ChrW("1608") & ChrW("1593") & _ ChrW("32") & ChrW("1575") & ChrW("1604") & ChrW("1576") & ChrW("1610") & ChrW("1575") & ChrW("1606") & ChrW("1575") & ChrW("1578") & ChrW("32") & ChrW("1575") & _ ChrW("1604") & ChrW("1605") & ChrW("1587") & ChrW("1578") & ChrW("1582") & ChrW("1583") & ChrW("1605") & ChrW("32") & ChrW("1607") & ChrW("1608") & ChrW("32") & _ ChrW("40") & ChrW("32") & FieldTypeName(strFieldName, strTableName) & ChrW("32") & ChrW("41") & ChrW("13") & ChrW("10") & ChrW("1605") & ChrW("1606") & ChrW("32") & _ ChrW("1601") & ChrW("1590") & ChrW("1604") & ChrW("1603") & ChrW("32") & ChrW("1602") & ChrW("1605") & ChrW("32") & ChrW("1576") & ChrW("1573") & ChrW("1583") & _ ChrW("1582") & ChrW("1575") & ChrW("1604") & ChrW("32") & ChrW("1576") & ChrW("1610") & ChrW("1575") & ChrW("1606") & ChrW("1575") & ChrW("1578") & ChrW("32") & _ ChrW("1578") & ChrW("1578") & ChrW("1591") & ChrW("1575") & ChrW("1576") & ChrW("1602") & ChrW("32") & ChrW("1605") & ChrW("1593") & ChrW("32") & ChrW("1606") & _ ChrW("1608") & ChrW("1593") & ChrW("32") & ChrW("1575") & ChrW("1604") & ChrW("1576") & ChrW("1610") & ChrW("1575") & ChrW("1606") & ChrW("1575") & ChrW("1578") _ & ChrW("32") & ChrW("1575") & ChrW("1604") & ChrW("1605") & ChrW("1587") & ChrW("1578") & ChrW("1582") & ChrW("1583") & ChrW("1605") Select Case Err.Number Case Is = 2471: MsgBox$ strErrMsg, vbCritical + vbMsgBoxRight + vbMsgBoxRtlReading, strErrMsgTitel Case Is = 3075: MsgBox$ strErrMsg, vbCritical + vbMsgBoxRight + vbMsgBoxRtlReading, strErrMsgTitel Case Else MsgBox$ Err.Number & ": " & Err.Description End Select Resume procDone End Function Public Function FieldTypeName(ByRef strFieldName As String, ByRef strTableName As String) As String Dim db As DAO.Database Dim objRecordset As DAO.Recordset Dim i As Integer Set objRecordset = CurrentDb.OpenRecordset(strTableName) For i = 0 To objRecordset.Fields.Count - 1 If strFieldName = objRecordset.Fields(i).Name Then Dim strReturn As String Select Case CLng(objRecordset.Fields.Item(i).Type) 'fld.Type is Integer, but constants are Long. Case dbBoolean: strReturn = "Yes/No" ' 1 Case dbByte: strReturn = "Byte" ' 2 Case dbInteger: strReturn = "Integer" ' 3 Case dbLong ' 4 If (objRecordset.Fields.Item(i).Attributes And dbAutoIncrField) = 0& Then strReturn = "Long Integer" Else strReturn = "AutoNumber" End If Case dbCurrency: strReturn = "Currency" ' 5 Case dbSingle: strReturn = "Single" ' 6 Case dbDouble: strReturn = "Double" ' 7 Case dbDate: strReturn = "Date/Time" ' 8 Case dbBinary: strReturn = "Binary" ' 9 (no interface) Case dbText '10 If (objRecordset.Fields.Item(i).Attributes And dbFixedField) = 0& Then strReturn = "Text" Else strReturn = "Text (fixed width)" '(no interface) End If Case dbLongBinary: strReturn = "OLE Object" '11 Case dbMemo '12 If (objRecordset.Fields.Item(i).Attributes And dbHyperlinkField) = 0& Then strReturn = "Memo" Else strReturn = "Hyperlink" End If Case dbGUID: strReturn = "GUID" '15 'Attached tables only: cannot create these in JET. Case dbBigInt: strReturn = "Big Integer" '16 Case dbVarBinary: strReturn = "VarBinary" '17 Case dbChar: strReturn = "Char" '18 Case dbNumeric: strReturn = "Numeric" '19 Case dbDecimal: strReturn = "Decimal" '20 Case dbFloat: strReturn = "Float" '21 Case dbTime: strReturn = "Time" '22 Case dbTimeStamp: strReturn = "Time Stamp" '23 'Constants for complex types don't work prior to Access 2007 and later. Case 101&: strReturn = "Attachment" 'dbAttachment Case 102&: strReturn = "Complex Byte" 'dbComplexByte Case 103&: strReturn = "Complex Integer" 'dbComplexInteger Case 104&: strReturn = "Complex Long" 'dbComplexLong Case 105&: strReturn = "Complex Single" 'dbComplexSingle Case 106&: strReturn = "Complex Double" 'dbComplexDouble Case 107&: strReturn = "Complex GUID" 'dbComplexGUID Case 108&: strReturn = "Complex Decimal" 'dbComplexDecimal Case 109&: strReturn = "Complex Text" 'dbComplexText Case Else: strReturn = "unknown" End Select End If Next i FieldTypeName = strReturn End Function يتم استدعاء الوظيقة بشكل عام من خلال الكود الاتى Call CheckInputExist("FieldName", "TableName", Me.txtBox) وأخيرا المرفق للتجربة ملاحظة : تم تعديل المرفق والكود بناء على رد استاذى الجليل الباش مهندس @Moosak التعديل النهائى بتحديث المرفق بتاريخ يوم السبت 22 رمضان 1443 هـ , 23 -أبريل -2022 م تم إضافة وظيقة للتعرف نوع البيانات المستخدم فى الحقل داخل الجدول Check Input Exist.accdb

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

السلام عليكم مفيش حاجة اسمها كده ... لازم انت تتأكد وتفحص وتجرب أفكارك يا افندم ده ليه بقه انت اولا لا فحصت ولا جربت الكود وثانيا الكود مش شغال يا بيه وثالثا فين المتغير اللى يحمل القيمة اللى نحتاج التأكد منها والاهم من كل ده انت وقعت فى الفخ .. نعم يا سيدى لقد وقعت فى الفخ فين النظرة المبعدية اللى تجعل الكود ذكى فلا تضطر مستقبليا فى الدخول للتعديل على الكود ؟! فين المنطق والتحليل هو القيمة التى نريد التأكد ان كانت موجود من قبل او لا فى القيم المسجلة بالجدول مش ممكن تكون رقم او نص او تاريخ ؟ انت بتهزر يا بيه 🥵 يا شماتة طنط ظاظا فيه نلتقى بعد الإفطار ان شاء الله

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

1 Dim stLinkCriteria As String Dim strMsgPrt1 As String Dim strMsgPrt2 As String Dim strMsgPrt3 As String strMsgPrt1 = ChrW("1578") & ChrW("1581") & ChrW("1584") & ChrW("1610") & ChrW("1585") & ChrW("32") & ChrW("1575") & ChrW("1604") & ChrW("1585") & ChrW("1602") & ChrW("1605") & ChrW("32") & ChrW("1575") & ChrW("1604") & ChrW("1588") & ChrW("1582") & ChrW("1589") & ChrW("1609") & ChrW("32") & ChrW("40") strMsgPrt2 = ChrW("32") & ChrW("41") & ChrW("32") & ChrW("1578") & ChrW("1605") & ChrW("32") & ChrW("1575") & ChrW("1587") & ChrW("1578") & ChrW("1582") & ChrW("1583") & ChrW("1575") & ChrW("1605") & ChrW("1607") & ChrW("32") & ChrW("1605") & ChrW("1606") & ChrW("32") & ChrW("1602") & ChrW("1576") & ChrW("1604") strMsgPrt3 = ChrW("1587") & ChrW("1608") & ChrW("1601") & ChrW("32") & ChrW("1610") & ChrW("1578") & ChrW("1605") & ChrW("32") & ChrW("1606") & ChrW("1602") & ChrW("1604") & ChrW("1603") & ChrW("32") & ChrW("1575") & ChrW("1604") & ChrW("1570") & ChrW("1606") & ChrW("32") & ChrW("1573") & ChrW("1604") & ChrW("1609") & ChrW("32") & ChrW("1575") & ChrW("1604") & ChrW("1587") & ChrW("1580") & ChrW("1604") & ChrW("46") stLinkCriteria = "[idnumber ]=" & Me.idnumber If DCount("*", "tblName", stLinkCriteria) > 0 Then MsgBox$ strMsgPrt1 & Me.idnumber & strMsgPrt2 & vbCr & vbCr & strMsgPrt3, vbExclamation + vbMsgBoxRight + vbMsgBoxRtlReading, "" Me.Undo Me.Recordset.FindFirst stLinkCriteria Else End If فقط غير tblName الى اسم الجدول تبعك