ابو جودي

اتفضل قم بمشاهدة هذا الموضوع برنامج انتظار الدور

راجع الموضوع الاتى عدم عرض التقرير إذا كان فارغ

طيب سوى جدول باسم tblRegistrationDate وسوى بداخلة حقل من نوع تاريخ باسم RegistrationDate وسوى جدول للتجربة باسم tblData وسوى بداخله اى حقول من اى نوع بيانات تريدها للتجربة سوى نموذج مصدر بياناته الجدول tblData على ان يكون داخل النموذج فى الفوتر مثلا بعيد عن الحقول الرئيسية للجدول العناصر الاتية بالترتيب بالاسماء الاتية عدد 2 مربع نص + عدد 1 زر أمر مربع النص الاول يكون باسم txtRegistrationDate مربع النص الثانى يكون باسم txtDayDate زر الامر سمه ما شئت الاكواد المستخدمة تكون كالاتى اولا عند فتح النموذج txtRegistrationDate = Nz(DLast("[RegistrationDate]", "tblRegistrationDate")) وهذا لجلب آخر قيمة تاريخ سوف تقوم بتسجيلها داخل جدول tblRegistrationDate ثانيا مربع النص txtDayDate اعتبره تاريخ اليوم ضع فيه تاريخ اليوم للتجارب كما تريد قصدت فى الشرح استخدامه كمربع نص لتغير قيمة التاربخ لمرونة التجربة بعد ذلك استبدله بدالة Date() ثالثا على زر الامر عند النقر ضع الكود الاتى Select Case Nz(txtRegistrationDate, "") Case Is = "": Exit Sub Case 1 = Format(CVDate(txtDayDate), "dd/mm/yyyy") > Format(CVDate(txtRegistrationDate), "dd/mm/yyyy") Me.AllowAdditions = True Me.AllowEdits = True Me.AllowDeletions = True Case Else Me.AllowAdditions = False Me.AllowEdits = False Me.AllowDeletions = False End Select Me.Requery اعتذر لتقديم الاجابة النظرية فقط فى الوقت الراهن

الكود يعمل بنجاح على الرغم من غرابة السؤال والاغرب منه تصور الافادة من تلك النتيجة قطعا اذا عرف السبب بطل العجب

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

ماشاء الله .. شغل جميل سلمت يمناك

ولكن الكود السابق قد نلاقى من وراءه بعذ الاخطاء فى حالة عدم وجود بيانات دولة فى جدول Cuntries حقل text1 فى جدول1 لا يحتوى على اى قيم وتلك هى السيناريوهات التى قد تحدث نتيجتها اخطاء وتوقف الكود عن العمل والتى خطرت على بالى لتلاشى تلك الاخطاء يكون الكود كالأتى On Error GoTo ErrorHandler Dim i As Integer Dim LookFor As String Dim FullName As String Dim strErrMsgTitel As String Dim strMsgErrPrt1 As String DoCmd.GoToRecord , , acFirst For i = 1 To Me.Recordset.RecordCount LookFor = Trim(Nz(Me.text1)) FullName = DLookup("[LongName]", "[Cuntries]", "[ShortName] Like '*" & LookFor & "*'") If IsNull(Me.text1) Then: Me.text2 = vbNullString: Else Me.text2 = FullName DoCmd.GoToRecord , , acNext GoTo nxfor DoCmd.GoToRecord , , acNext nxfor: Next i procDone: Exit Sub ErrorHandler: strErrMsgTitel = ChrW("1582") & ChrW("1591") & ChrW("1571") strMsgErrPrt1 = ChrW("62") & ChrW("62") & ChrW("45") & ChrW("45") & ChrW("45") & ChrW("62") & ChrW("32") & ChrW("32") & ChrW("1607") & ChrW("1584") & ChrW("1607") & ChrW("32") & ChrW("1575") & ChrW("1604") & ChrW("1583") & ChrW("1608") & ChrW("1604") & ChrW("1577") & ChrW("32") & ChrW("1594") & ChrW("1610") & ChrW("1585") & ChrW("32") & ChrW("1605") & ChrW("1583") & ChrW("1585") & ChrW("1580") & ChrW("1577") & ChrW("32") & ChrW("1576") & ChrW("1580") & ChrW("1583") & ChrW("1608") & ChrW("1604") & ChrW("32") & ChrW("1575") & ChrW("1604") & ChrW("1583") & ChrW("1608") & ChrW("1604") Select Case Err.Number Case Is = 94 MsgBox$ LookFor & " " & strMsgErrPrt1, vbCritical + vbMsgBoxRight + vbMsgBoxRtlReading, strErrMsgTitel FullName = vbNullString Resume Next Case Else MsgBox$ Err.Number & ": " & Err.Description End Select Resume procDone db2_text (5).mdb

ولو اخدت بالك انا قلت واسمح لى استاذى @Moosak طالما سبقتمونى اليها لانى كنت ناوى اقدم الفكرة الاخرى اليوم تعديل بسيط بوضع الكود على زر الامر كما يريد الاستاذ @سمير1404 Dim i As Integer Dim LookFor As String Dim FullName As String DoCmd.GoToRecord , , acFirst For i = 1 To Me.Recordset.RecordCount LookFor = Trim(Nz(Me.text1)) FullName = DLookup("[LongName]", "[Cuntries]", "[ShortName] Like '*" & LookFor & "*'") If IsNull(Me.text1) Then: Me.text2 = vbNullString: Else Me.text2 = FullName DoCmd.GoToRecord , , acNext GoTo nxfor DoCmd.GoToRecord , , acNext nxfor: Next i db2_text (4).mdb

هذا تعديل بسيط New Microsoft Office Access 2007 قاعدة بيانات(2).mdb

من عيونى تحت امرك اولا الدالة InStr هى تستخم لمعرفة موضع أول ظهور لسلسة نصية فى سلسلة نصية آخرى وهنا لاننا نريد الكلمة الأولى والتى تبدأ بعدها مسافة سوف نعتبر ان المسافة هى المرشد الذى نستخدمه نريد معرفة موضع المسافة الاولى فى السلسة النصية كلها وعندما نستخدم الدالة InStr بهذا الشكل InStr([text1] & ""," ") سوف تعيد لنا رقم موضع المسافة داخل السلسلة النصية ثانيا الدالة Left تستخدم هذه الداله لاستخلاص جزء من الجهه اليسرى من النص ونمرر لها وسيطين الوسيط الاول وهو source وهو النص الاصلى الوسيط الثانى وهو length هو طول النص الذى تريد استخلاصه من النص الاصلى من الجهه اليسرى من النص وبما اننا حصلنا على رقم موضع المسافة من الدالة السابقة سيكون هو الوسيط الثانى الـ length فتكون الدالة بهذا الشكل Left([text1],8-1) وطبعا لاننا نريد حذف المسافة اضفنا -1 وبالنسبة لباقى الكود Select Case اعتقد مفهوم انظر للمرفق الاتى فى الاستعلام Query1 سوف تتضح لكم الررية افضل db2_text (3).mdb جزاكم الله خيرا .. اهلا بك ولكن لى وجهة نظر صغيرة لم نضع القيم مرة اخرى فى الحقل text2 بينما فكرتى الأولى توفر لك استخدما البيانات وتوفير حقل فى الجدول لقد وضعت لكم الفكرة تفى بالغرض وتصل بكم لمبتغاكم بطريقة مباشرة مع امكانية الاستغناء عن الحقل text2 فى الجدول وتوفير حجم البيانات

اتفضل db2_text (2).mdb

جرب هذا التعديل على الكود الخاص بالاستاذ @عمر ضاحى Dim i As Integer DoCmd.GoToRecord , , acFirst For i = 1 To Me.Recordset.RecordCount If Me.text1 Like "*" & "مصر" & "*" Then Me.text2 = "جمهورية مصر العربيه" ElseIf Me.text1 Like "*" & "السعودية" & "*" Then Me.text2 = "المملكة العربيه السعودية" ElseIf Me.text1 Like "*" & "الامريكية" & "*" Then Me.text2 = "الولايات المتحده الامريكيه" ElseIf Me.text1 Like "*" & "الاردنية" & "*" Then Me.text2 = "المملكة العربيه الهاشمية" End If DoCmd.GoToRecord , , acNext If NewRecord Then Exit Sub GoTo nxfor DoCmd.GoToRecord , , acNext nxfor: Next i

وهذه فكرتى المتواضعة من خلال وظيفة داخل وحدة نمطية Function GoExt(strText As String) Dim strExtractionWord As String: strExtractionWord = Nz(Left([strText], InStr([strText] & "", " ") - 1), strText) Select Case strExtractionWord Case Is = strText: GoExt = strText Case Is = "مصر": GoExt = "جهورية" & " " & strText Case Is = "العربية": GoExt = "المملكة" & " " & strText Case Is = "المتحدة": GoExt = "الولايات" & " " & strText Case Is = "الاردنية": GoExt = "المملكة العربية" & " " & strText End Select End Function يتم استدعاء الوظيفة من خلال GoExt([text1]) ولا انصح بكتابة الأحرف العربية داخل محرر الاكود ممكن نستخدم اليونيكود او جدول واستخدام DLookup ويكون التطبيق كالاتى db2_text.mdb

انت وضعت الكود داخل النموذج ليه تعديل قاعدتك Check Input Exist .accdb

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

جرب المرفق الاتى لو تكرمت Check Input Exist.accdb

وعليكم السلام ورحمة الله تعالى وبركاته تقبل الله ومنا ومنكم وجزاكم الله خيرا ممكن المرفق لو تكرمت انت عارف اخوك ضعيف بالنظرى

انا قمت بتحميل المرفق .... القاعدة تفتح وتعمل بشكل طبيعى جدا

تم حل المشكلة

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")