كل الانشطه

سلام عليكم سادة الاعضاء كيف حالكم اتمنى ان تكونوا في احسن حال ان شاء الله عندي مشكلة في برنامج عملته بالاكسال في اغلب الاحيان عندما اريد تسحيل العمل تخرج لي رسالة التي في الصورة 1 ولما اسجل تاتي مثل ماهو موضح في الصور وفي الاخير اجد انه لم يسجل العمل الذي قمت به ويعيدني الى وضع السابق فهل له علاقة بكثرة المعادلات والاكواد ارجو ات اجد عندكم الجواب لان البرنامج مهم جدا لي etat.rar

النتائج الخاطئة كانت (8) أصبحت بهذه الإضافة (6) وبالنسبة للوقت .. فيبدو أني أخطأت في التعبير .. مشكلتي كانت أن الدالة أخذت الكثير من الوقت عدة ساعات ولم تتوقف .. مما أجبرني على إيقافها .. يعني أنها (علقت) 🙂 إذا كانت بشكل سليم فعندي استعداد أن أترك الجهاز عدة ساعات يعمل للحصول على أفضل النتائج .. ولكن أكون مطمئنا أنها تعمل وليست (معلقة) 😀 ثانيا.. أخي الكريم، أنا أريد دالة توفر لي الوقت للحصول على أفضل النتائج الممكنة، وسوف أقوم بمراجعة النتائج وأعلم أنه لا يمكن الحصول على نتائج دقيقة 100% توجد في الملف عدة تعقيدات تحول حتى دون الوصول إلى نتائج بنسبة 70% في تقديري ولكن أسعى للحصول على الأفضل قدر الإمكان لتسهيل المراجعة مثلا .. طلبي أن يكون البحث عن الرقم بعد اسم الكتاب إلى نهاية الحقل وليس بعد اسم الكتاب مباشرة، على أساس أنه قد تتأخر بعض الأرقم كما في الصورة التي أرفقتها مسبقا هذا الطلب يحل لي مشكلة، لكنه يوقعني في مشكلة أخرى مشكلة شبيهة بالتي تحصل عند البحث عن الرقم حتى لو كان قبل اسم الكتاب كما في هذا المثال إذا كان المطلوب البحث عن معجم ابن عساكر (611)، فسيخرج هذا الحديث لوجود الرقم (611) بعد اسم الكتاب بعدة أسطر ويوجد عدة أمثلة لهذه الظاهرة لكن في تقديري أن الإبقاء على خاصية البحث عن الرقم ولو كان بعد اسم الكتاب بعدة أسطر فائدتها أكبر من مضارها وكما ذكرت .. توجد تعقيدات أخرى سوف تتسبب بخطأ في النتائج .. لكن إذا تجاوزنا مشكلة البحث عن الرقم بعد اسم الكتاب فقط وليس قبله، كما تجاوزنا مشكلة البحث عن الرقم كاملا .. فأنا راض بالنتيجة .. والله الميسر

ابعت اخى @محمد هشام. رسالة لى على الخاص

أنا خلاص غيرت رأيي وأقتنعت بيك 😂 وعايزني أفوت الفرصة العظيمة دي 😊👌 ----------------------------------------------------------------------------- أنا حاسس أنك يحتاج تعيد النظر في استخدام TabIndex كقيمة يعتمد عليها في الكود لأنها ممكن تتغير لوحدها في أي لحظة لو عملت إعادة ترتيب تلقائي بدون شعور 😁🖐🏻

وعليكم السلام ورحمة الله وبركاته أهلا بك أخي @mohamed_ashour في المنتدى 🙂 تكرما اطرح سؤالك في موضوع جديد ، إتباعا لقواعد المشاركة في المنتدى 🙂🌹

بعد مراجعة هذا الجزء مرة أخرى هذا يمكن الوصل اليه إن شاء الله أثناء عملية البحث ولكني اريد معرفة الاحتمالات التي قد نوجهها حتي نحاول إن شاء الله ان نصل الي تصور مناسب لان كما فهمت أيداً ان عنصر الوقت مهم علي سبيل المثال يمكن استخدام وظيفة كهذه لتقطيع النص Public Function cutString(ByVal fullText As String, _ ByVal cutBy As String, _ Optional ByVal lrSide As String = "leftSide") As String On Error GoTo ErrorHandler If fullText = "" Then 'Debug.Print "Error: fullText is empty" cutString = "" Exit Function End If If cutBy = "" Then 'Debug.Print "Error: cutBy is empty" cutString = fullText Exit Function End If If Len(cutBy) > Len(fullText) Then 'Debug.Print "Error: cutBy is longer than fullText" cutString = fullText Exit Function End If Select Case LCase(lrSide) Case "leftside", "rightside" Case Else 'Debug.Print "Warning: Invalid lrSide value '" & lrSide & "'. Using default 'leftSide'." lrSide = "leftSide" End Select Dim position As Long position = InStr(1, fullText, cutBy, vbTextCompare) If position > 0 Then Select Case LCase(lrSide) Case "leftside" cutString = Mid(fullText, position) 'Debug.Print "Info: Returning left side from '" & cutBy & "'" Case "rightside" cutString = Left(fullText, position + Len(cutBy) - 1) 'Debug.Print "Info: Returning right side up to '" & cutBy & "'" End Select Else 'Debug.Print "Warning: '" & cutBy & "' not found in fullText. Returning original string." cutString = fullText End If ExitFunction: Exit Function ErrorHandler: Select Case Err.Number Case 13 ' Type mismatch Debug.Print "Error 13: Type mismatch. Ensure all arguments are strings." Case 5 ' Invalid procedure call or argument Debug.Print "Error 5: Invalid argument. Check the function call." Case Else Debug.Print "Unexpected Error " & Err.Number & ": " & Err.Description End Select cutString = fullText Resume ExitFunction End Function ويمكن استخدامها مباشرةً باستبدال هذا الجزء من الكود sqlStr = "SELECT TAB.MNO, TAB.NASS " & _ "FROM TAB " & _ "WHERE TAB.NASS LIKE '*" & Nz(!BookName, "") & "*' " & _ "AND InStr(cutString([NASS],'" & Trim(!BookName) & "','leftSide'),'" & Nz(!B_Hno, "") & "') > 0;" ولكن زاد وقت المعالجة إلي It Takes | 661MS | To resolve | 21 | Records. لقد كنت أجهز للمشاركة ولم اري ردك شوف اقم بالتجربة وسأنتظر ردك بعد تجربة الوظيفة والاضافة الجديدة

السلام عليكم هل يمكن ان اتوصل معك

أخي الكريم .. في الملف الجديد المرفق أمثلة يظهر فيها أهمية أن يكون البحث بعد اسم الكتاب وبخلاف ذلك ستحدث الأخطاء الأرقام الصحيحة في حقل (MNOX) وعدد الأخطاء في الملف (8) وكلها لنفس السبب وقد ميزتها بعلامة (1select) وهذا أحدها الدالة بحثت أولا عن اسم الكتاب (الطيوريات) ثم بحثت عن الرقم المطلوب وهو (135) ووجدتهما في (TAB) في الحديث رقم (30731) ولكنه ليس هو المطلوب لأن الرقم (135) الذي تم إيجاده ليس هو رقم الحديث في كتاب الطيوريات وإنما رقما لحديث في كتاب آخر ذُكر قبله قد يعد هذا الأمر مصادفة .. ولكنها كثيرة الحدوث لا بد من البحث عن الرقم بعد اسم الكتاب والرقم الصحيح للحديث المطلوب كما في حقل (MNOX) هو : (62993) ويمكن استعراض أحاديث (BOOKS) وما يقابلها من الملف الرئيسي (TAB) من خلال نموذج (BOOKS) وبالنقر المزدوج على رقم (MNOX) يظهر الحديث الصحيح المطلوب Smart_Search_New01.accdb

جزاكم الله خيرا

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

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

بالنسبة لرسالة الخطأ الاولي فيمكن حلها بأكثر من طريقة استبدل الكود tabRS.MoveLast tabRS.MoveFirst بهذا On Error Resume Next tabRS.MoveLast tabRS.MoveFirst On Error GoTo 0 اما بخصوص البحث عن الرقم فانا ابحث عن الرقم في كل الحديث لا يهم ان كان قبل النص او بعده في حال كان ناتج البحث 1 فلا يوجد مشكلة في حال كان هناك أكثر من ناتج اقم بتحديد موقع الرقم ومن ثم اذهب الي الوراء حتي اجد اول الرقم ومن ثم اذهب للأمام حتي اجد اخر الرقم وذلك حتي نتمكن من استخراج الرقم ومقارنته بالرقم الأصلي فاذا تطابق نعتمد هذا الناتج وذلك حتي نستطيع التمييز بين 312 و 1312 اذا امكنك مشاركة قاعدة بها احتمالات أكثر حتي نحاول بإذن الله من إيجاد حلول مناسبة

نأمل كتابة العنوان يصف الموضوع ولو بشكل مختصر

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

جزاك الله خيرا أخي الكريم .. وأنا بحاجة لوقت لاستيعاب هذه المستجدات .. والآن تركيزي على التجارب بعد التجربة على ملف أكبر قليلا خرجت هذه الرسالة وبقي (188) حديثا من أصل (282) لم يعمل فيها الكود وعند مراجعة نتائج ما عمل فيه الكود ظهرت بعض الأخطاء التي مرجعها إلى وجود الرقم المطلوب قبل اسم الكتاب لذلك لا بد من البحث عن الرقم بعد اسم الكتاب وما قبله لا اعتبار له لذلك انا عندما كنت أجري التجارب الأولية -لكوني أعشق التجارب- خطر على بالي إعداد نص خاص للبحث يحذف كل النص الذي قبل اسم الكتاب المطلوب ليكون البحث فيما بعده، وهذا يقتضي أن أعد نصا خاصا لكل اسم كتاب .. وهذا حل غير عملي بالطبع 😁

يسعدني اكتساب هذه المعلومة بصدق

مثال للتجربه الاصناف.accdb

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

ارفع نموذج للعمل علية ويمكن استخدام دالة Replace اذا فهمت طلبك صح 'مثال txtInput.Value = Replace(txtInput.Value, " ", "__") وهذا مثلا عند حدث عند التحديث

عندي في الاكسيس مربع تحرير وسرد عايز لما اعمل مسافه يضيف كلمه ___ او ____ مثال مثلا اختارت في المربع كلمه سكر بعد الضغط علي مسطرة تضاف كلمه او سكر او زيت او دقيق

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

أرجو لك من الله التوفيق وبانتظار نتائج تجاربك لقد قمت بالتعديل علي الملف الأخير الذي قمت بمشاركته 1- اضفت موديول لحساب الوقت حتي تتمكن من حساب وقت العملية 2- قمت بالتطبيق علي الكود ( It Takes | 14MS | To resolve | 21 | Records. ) 3- قمت بتعديل ( Dim totalRec As String ) إلي ( Dim totalRec As Long ) النسخة بالمرفقات والأكواد المعدلة في أخر الموضوع كما أود الإشارة الي هذا السطر في الكود If totalRec Mod 1000 = 0 Then DoEvents وظيفته بشكل مختصر هي توقف تنفيذ الكود كل 1000 سجل حتي يتمكن البرنامج من التحرر وتلقي التحديثات ويحد من مشكلة عدم الاستجابة "Not Responding" لذا يمكنك التعديل علي الرقم 1000 بما يتناسب مع استخدامك مع الاخذ في الاعتبار ان هذا يؤثر علي الوقت الإجمالي للعملية يوجد فيديوهات تشرح الامر بالتفصيل ( كما يمكنك الاطلاع علي الرابط التالي https://wellsr.com/vba/2018/excel/vba-doevents-and-when-to-use-it/ 1- Timer Class MODULE ATTACHED 2- الكود بعد التعديل وتطبيق استخدام (Timer Class MODULE) Public Sub mnoSmartSearch() Dim db As DAO.Database Dim rs As DAO.Recordset Dim tabRS As DAO.Recordset Dim tblName As String Dim sqlStr As String Dim foundMno As String Dim exNum As String Dim stext As String Dim totalRec As Long Dim sPos As Long Dim startPos As Long Dim endPos As Long Dim i As Long Dim sTimer As ahmosTimer Dim itTakes As String tblName = "BOOKS" If DCount("*", tblName) = 0 Then MsgBox "There are no records in the table " & tblName, vbExclamation + vbOKOnly, "No Records Exist Error" Exit Sub End If Set sTimer = New ahmosTimer sTimer.StartTimer Set db = CurrentDb Set rs = db.OpenRecordset(tblName, dbOpenDynaset) With rs .MoveLast .MoveFirst totalRec = .RecordCount Do While Not .EOF sqlStr = "" foundMno = "" If Not IsNull(!BookName) And Not IsNull(!B_Hno) Then sqlStr = "SELECT TAB.MNO, TAB.NASS " & _ "FROM TAB " & _ "WHERE TAB.NASS LIKE '*" & Nz(!BookName, "") & "*' " & _ "AND InStr([NASS],'" & Nz(!B_Hno, "") & "') > 0;" Set tabRS = db.OpenRecordset(sqlStr, dbOpenSnapshot) tabRS.MoveLast tabRS.MoveFirst If tabRS.RecordCount = 0 Then ' No Results found Debug.Print "NotFound", !BookName, !B_Hno ElseIf tabRS.RecordCount = 1 Then ' One Result Found and that what we want foundMno = Nz(tabRS!MNO, "") If foundMno <> "" Then .Edit !MNO = foundMno .Update End If Else ' more than one record found and that shouldn't happen ' Debug.Print "Found Times is : " & tabRS.RecordCount, rs!BookName, rs!B_Hno Do While Not tabRS.EOF sPos = 0 i = 0 startPos = 0 endPos = 0 exNum = "" stext = "" stext = tabRS!NASS sPos = InStr(1, stext, rs!B_Hno) i = sPos Do While i > 0 And IsNumeric(Mid(stext, i, 1)) i = i - 1 Loop startPos = i + 1 ' Move forward to find the end of the number i = sPos Do While i <= Len(stext) And IsNumeric(Mid(stext, i, 1)) i = i + 1 Loop endPos = i - 1 exNum = Mid(stext, startPos, endPos - startPos + 1) If rs!B_Hno = exNum Then .Edit !MNO = Nz(tabRS!MNO, "") .Update Exit Do End If tabRS.MoveNext Loop End If If Not tabRS Is Nothing Then tabRS.Close Set tabRS = Nothing End If Else ' BookName or B_Hno are Empty Debug.Print "BookName or B_Hno are Empty" End If .MoveNext If totalRec Mod 1000 = 0 Then DoEvents Loop End With If Not rs Is Nothing Then rs.Close Set rs = Nothing End If If Not db Is Nothing Then Set db = Nothing sTimer.StopTimer itTakes = sTimer.GetElapsedTime If Not sTimer Is Nothing Then Set sTimer = Nothing Debug.Print "It Takes | " & itTakes & " | To resolve | " & totalRec & " | Records." End Sub Smart_Search03_byAhmos.accdb ahmosTimer.zip

TRY.xlsx

السلام عليكم كنت محتاج انقل المبلغ المناسب حسب الوظيفة ومرفق الاكسيل نقل المبلغ.xls

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