ابو جودي

طيب ممكن نضيف السطر الاتى للكود وتم التعديل فى المرفق الرئيسي 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 الى اسم الجدول تبعك

طيب اتفضل جرب رسالة خطاء عند فتح سجل جديد.accdb

ههههههه غريبة احنا حتى فى رمضان ان امكن رفع القاعدتان للتحربة

ولا عبقرية ولا شئ .. هذا فضل الله اهلا بك

ممكن مرفق القاعدة

ارفق قاعدة بياناتك

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

السلام عليكم ورحمة الله تعالى وبركاته إصلاح مشاكل قواعد البيانات أداة لاستعادة البيانات الناجمة عن تلف قواعد البيانات تستخدم تقنيات متقدمة لفحص قواعد بيانات Microsoft Access التالفة وتدعم النسيقات (.mdb . accdb) وتقوم باستعادة أكبر قدر ممكن من البيانات مما يقلل الخسارة الناجمة عن تلف قواعد البيانات. الاداة مجانية للاستخدام الغير تجارى من يريد الكراك يراسلنى على الخاص حتى لا ننتهك قوانين المنتدى بنشرها 159905355_DataNumenAccessRepair.rar

انا عارف انك شغال على شئ سوف يرى النور قريبا وانا منتظر بلهفة مشتاق ديما شغالين لا تقلق ابشر بالخير ان شاء الله

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

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

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

انظر الى الموضوع هذا ان شاء الله تجد فيه مرادك وهذا التطبيق على قاعدتك .. اتفضل Database11 v2.accdb

ماشاء الله... الله اكبر يا دكتور @د.كاف يار جزاكم الله خيـرا

اتفضل اسف كنت مستعجل ولم انتبه لتلك النقطة جدول البرامج-v3.accdb

اتفضل تجربة سريعة لانى مستعجل الان وقت صلاة العشاء والتروايح السلام عليكم جدول البرامج-v2.zip

اتفضل ياسيدى بس انا عندى مشكلة فى ضبط اخر حالة مش قادر اعرف السبب افتح النموذج frmFilter وشوف الجزء الاول الفرز بالرتبة تمام يعمل منفردا او يتم التصفية والفرز بناء عليها مع باقى القيم الاتية فى باقى الشروط الجزء الثانى الفرز بالجنس مثل سابقه الجزء الثالث والذى يحوى المشكلة يتم الفرز ولكن تختفى البيانات انا الان رايح اصلى التراويح بعدين نكمل ان شاء الله Database1011 v4.accdb

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

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