Ahmos

الحمد لله والشكر لله أخي الكريم التعديل علي رأس الدالة يعني التعديل علي القيم الافتراضية فقط بمعني وضع كلمة Optional تجعل هذا الجزء أختياري وإذا وضعت له قيمة فتصبح هذه هي القيمة الافتراضية فمثلاً الدالة التي اشرت اليها تطلب 6 معلومات 4 لن تعمل بدونهم و2 اختياري وقد تم وضع قيمتهم الافتراضية إذا استخدمتها بدون المقاطع الاختيارية فتعتمد القيمة الافتراضية مثال إذا قمت بعمل دالة لجمع رقمين function sumTwoNums(num1 as integer,optional num2 as integer = 5) as integer هنا يلزم إدخال قيمة الرقم الأول num1 اما الرقم الثاني num2 فاختياري وفي حالة لم يتم إدخاله يعتبر موجود بقيمته الافتراضية 5 ويمكن وضع قيم اختيارية داخل الدالة بدون تحديد قيمتها الافتراضية function sumTwoNums(num1 as integer,optional num2 as integer ) as integer ولكل طريقة استخدامها كما ان هذه الدالة ليست هي المستخدمة داخل الكود بل هذه لان هذه الدالة تعود بـ True في حالة وجود تطابق او False اما الدالة الأخرى فتعود بقيم التطابق وإذا اردت التعديل فداخل الكود (nssjSmartSearch_byPage) هنا ------------------------------------- فكرتك حلوة وذكية ربنا يوفقك ويبارك فيك

الأستاذة / حنان الأخوة الكرام تحية طيبة وبعد ،،، كما فهمت المطلوب هو دالة لتغير مقاس الصورة الدالة المستخدمة هي WIA_ResizeImage وهذه الدالة تقوم بتغير أبعاد الصورة بـ البكسل PIXEL والبكسلز تتغير بثلاث عوامل الطول والعرض والجودة لذا يجب العلم ان عند تحويل المقاس إلي 8.5 سم × 11 سم يجب أن يتم تحديد أيضاً الجودة المطلوبة والصور التالية توضح الأمر والان نأتي الي الأكواد 1- الاكواد المساعدة للتحويل من MM / CM / INCH إلي PIXELS يجب وضعها في بداية مديول جديد Option Explicit Public Enum convertFrom cm mm inch End Enum Public Enum qualityRes q72PPI = 72 q96PPI = 96 q150PPI = 150 q200PPI = 200 q300PPI = 300 End Enum Public Function ConvertToPixels(Value As Double, unit As convertFrom, resolution As qualityRes) As Double Dim inches As Double Dim finalResolution As Double If Value < 0 Then Debug.Print "ConvertToPixels", "Measurement value must be non-negative." ConvertToPixels = 0 Exit Function End If Select Case unit Case convertFrom.cm inches = Value / 2.54 Case convertFrom.mm inches = Value / 25.4 Case convertFrom.inch inches = Value Case Else Debug.Print "ConvertToPixels", "Invalid unit" ConvertToPixels = 0 Exit Function End Select finalResolution = resolution ConvertToPixels = inches * finalResolution End Function كما يمكن استخدام هذا الموقع للتحويل https://www.aspect-ratios.com/pixel-calculator/ كود التجربة Sub test_ChangeImageSize() Dim sourceImgPath As String Dim targetImgPath As String Dim imgWidth As Double Dim imgHight As Double Dim pxlWidth As Long Dim pxlHight As Long Dim keepAspectRatio As Boolean Dim overWrtieTargetFile As Boolean sourceImgPath = "C:\Users\user\Downloads\Compressed\Cropping an Image With Controll Print v.1\Images\4130001.jpg" targetImgPath = "C:\Users\user\Downloads\Compressed\Cropping an Image With Controll Print v.1\Images\4130001_2.jpg" imgWidth = 8.5 imgHight = 11 keepAspectRatio = False overWrtieTargetFile = True pxlWidth = Round(ConvertToPixels(imgWidth, cm, q300PPI), 0) pxlHight = Round(ConvertToPixels(imgHight, cm, q300PPI), 0) If WIA_ResizeImage(sourceImgPath, targetImgPath, pxlWidth, pxlHight, keepAspectRatio, overWrtieTargetFile) Then Debug.Print "Your Image Resized Successfully" Else Debug.Print "Something Went Wrong !" End If End Sub هذا الإختيار للحفاظ علي تناسق ابعاد الصورة وبالطبع انم لم تكن الابعاد المستخدمة متناسقة فستختلف النتيجة لذا تم عمله هكذا حتي تخرج الصورة بالأبعاد المحددة keepAspectRatio = False وهذا الاختيار للكتابة فوق الملف الجديد إذا كان موجود بالفعل overWrtieTargetFile = True بالتوفيق

تفضل أخي الكريم الملف مع التطبيق علي الكود الأساسي والبحث باسم من خلال النموذج يمكنك التجربة وفي انتظار وملاحظاتك وتعديلاتك بالتوفيق Smart_Search_Pages_V2.zip

اخي الكريم لم يتم تطبيق هذا التحديث علي الكود الاساسي فقط تم التعديل علي الدالة ويوجد كود لاختبارها وهو ( Sub Test_isBookInTextPageNum() وانا في انتظار أن تقوم بالتجربة ومن ثم تخبرني او نتناقش في اي البدائل أفضل ليتم تطبيقه

أبدأ من حيث انتهيت الدالة الان تطابق وتبحث عن رقم الصفحة قبل او بعد الـ - يمكن ان نجعل الدالة تطابق النتائج القريبة فقط أي بعد الجزء و الفاصل فقد كنت أفكر في هذا الأمر والحمد لله تم التعديل علي الدالة إليك الدالة الجديدة ومثال عليها Public Function isBookInTextPageNum(ByVal fullText As String, _ ByVal BookName As String, _ ByVal partNum As String, _ ByVal pageNum As String, _ Optional exactPartOnly As Boolean = True, _ Optional Nearest As Boolean = True) As Boolean On Error GoTo ErrorHandler Dim regex As Object Dim matches As Object Dim match As Object Dim pattern As String Set regex = CreateObject("VBScript.RegExp") If exactPartOnly Then If Nearest Then pattern = "(?:" & BookName & "\s*[|_/\\ -]*\s*[\s*|'\(\[\{""]*" & partNum & "\s*[;¡`,|_/\\ -]*\s*[;¡`,|'\(\[\{""]*" & pageNum & ")" Else pattern = "(?:" & BookName & "\s*[|_/\\ -]*\s*[\s*|'\(\[\{""]*" & partNum & "\s*[;¡`,\d|_/\\ -]*\s*[;¡`,\d|'\(\[\{""]*" & pageNum & ")" End If Else If Nearest Then pattern = "(?:" & BookName & "\s*[|_/\\ -]*\s*[\s*|'\(\[\{""]*" & partNum & "\s*[;¡`,|_/\\ -]*\s*[;¡`,|'\(\[\{""]*" & pageNum & "\s*[|_/\\ -]*\s*[|'\)\(\[\{""]*" & ")" Else pattern = "(?:" & BookName & "\s*[|_/\\ -]*\s*[\s*|'\(\[\{""]*" & partNum & "\s*[;¡`,\d|_/\\ -]*\s*[;¡`,\d|'\(\[\{""]*" & pageNum & "\s*[\d|_/\\ -]*\s*[|'\)\(\[\{""]*" & ")" End If End If With regex .Global = False .MultiLine = True .IgnoreCase = False .pattern = pattern End With Set matches = regex.Execute(fullText) If Not matches Is Nothing And matches.count > 0 Then ' Debug.Print "Book(s) found in text:" ' For Each match In matches ' Debug.Print "Found : " & match.Value ' Next isBookInTextPageNum = True Else isBookInTextPageNum = False End If CleanAndExit: If Not regex Is Nothing Then Set regex = Nothing If Not matches Is Nothing Then Set matches = Nothing Exit Function ErrorHandler: Debug.Print "Error: " & Err.Description isBookInTextPageNum = False Resume CleanAndExit End Function إذا أردت طباعة النتائج وقت الاختبار فقط قم بتفعيل هذا الجزء داخل الدالة بحذف علامة ' ' Debug.Print "Book(s) found in text:" ' For Each match In matches ' Debug.Print "Found : " & match.Value ' Next الان كود التجربة والنتائج Sub Test_isBookInTextPageNum() Dim fullText As String Dim BookName As String Dim partNum As String Dim pageNum As String Dim result As Collection Dim match As Variant fullText = "The text includes book names and parts such as: bookName (1 \ 100 - 200 , 100-140), bookName (2 \ 150)." BookName = "bookName" partNum = "1" pageNum = "100" Debug.Print "------------------------------------" Debug.Print isBookInTextPageNum(fullText, BookName, partNum, pageNum, True, True) Debug.Print "------------------------------------" Debug.Print isBookInTextPageNum(fullText, BookName, partNum, pageNum, False, True) Debug.Print "------------------------------------" Debug.Print isBookInTextPageNum(fullText, BookName, partNum, pageNum, True, False) Debug.Print "------------------------------------" Debug.Print isBookInTextPageNum(fullText, BookName, partNum, pageNum, False, False) Debug.Print "------------------------------------" End Sub الان النتائج هي: ------------------------------------ Book(s) found in text: Found : bookName (1 \ 100 True ------------------------------------ Book(s) found in text: Found : bookName (1 \ 100 - True ------------------------------------ Book(s) found in text: Found : bookName (1 \ 100 - 200 , 100 True ------------------------------------ Book(s) found in text: Found : bookName (1 \ 100 - 200 , 100-140) True ------------------------------------ فقد قمت بإضافة للدالة تتيح الاختيار بين أربع احتمالات باستخدامهم معاً Optional exactPartOnly As Boolean = True هذا يخبر الدالة ان تقف عن وجود تطابق ام تكمل حتي أخر ( Optional Nearest As Boolean = True وهذا يخبرها ان تقف عند أقرب نتيجة ام تكمل لو أمكنك التجربة بالمثال السابق وتغير الأرقام وتخبرني أي اختيار نستخدم وللعلم إذا قمت بتعديلات التالية ستجد ان الدالة تعود بجميع النتائج المطابقة من داخل النص وهذا لن يفيد في طريقة الاستخدام الحالية ولكن يمكن استخدامها لاحقاً داخل الدالة نعدل التالي With regex .Global = True .MultiLine = True .IgnoreCase = False .pattern = pattern End With تم تغير من .Global = False إلي .Global = True والان نذهب للمثال ونعدل النص إلي fullText = "The text includes book names and parts such as: bookName (1 \ 100 - 200 , 100-140), bookName (1 \ 100)." ونكمل حديثنا بعد تجربة أخرى إن شاء الله

السلام عليكم ورحمة الله وبركاته بسم الله الرحمن الرحيم وبه نستعين أخي الكريم فضلاً قم بتجربة الملف المرفق لدي بعض الأسئلة 1- فيما يخص الـ allFoundMNO فقد لا يتم تسجيلهم جميعاً وذلك لسبب كما في هذه الصورة ستجد ان نتائج البحث 5 ولكن الأرقام التي تم تسجيلها تختلف وذلك لان في هذا الجزء من الكود إذا وجد نتيجة مطابقة يتوقف عن البحث وإذا اردنا ان لا يتوقف حتي نسجل كل النتائج علينا ان نأخذ في الاعتبار - الوقت - هل نريد ان يتم تسجيل اول نتيجة مطابقة او أخر نتيجة في foundMNO وهو يحمل القيمة التي سيتم وضعها في MNO 2- عند المراجعة وجدت هذه الحالة وأردت السؤال عنها الأمر هنا ان اسم الكتاب مختلف فاذا كان الاسم الذي تم استخدامه في اول بحث هو الأربعين للبكري فستظهر النتيجة الاولي فقط أقصد انه لن يتم رصد بدائل كما ان آلية البحث تعتمد أن الخلية في العمود MNO تكون فارغه فاذا كان هناك نتيجة مسجلة فلن تبحث باسم الكتاب الموجود في BookName2 1- في انتظار مراجعتك وملاحظاتك وكيف تريد ان يتم تعديل آلية البحث حتي توفر لك أفضل نتيجة ممكنة 2- هل تملك الصفحات كاملة داخل قاعدة البيانات ؟ بالتوفيق Smart_Search_Pages_V1.zip

إن شاء الله الأمر ميسر وسيفتح الله لنا ولكن أحاول ان استوضح منك لمعرفة الحالات التي قد نوجهها في المثال الذي ذكرته فكيف يحدث هذا و 132 و133 ارقام صفحات و 33 و 34 أيضاً سؤال رقم الصفة الموجود بالملف هو دائماً الرقم الأول صح ؟ مثل 132 و 33 آلية البحث التي أفكر بها بعد اسم الكتاب مسافات او لا ( او لا مسافات او لا ثم رقم الجزء ثم مسافات او لا ثم فاصل / سؤال هل يتغير الفاصل او هو دائمة / ثم مسافات او لا ثم رقم الصفحة فاذا كان رقم الصفحة الذي سنبحث عنها هو دائماً الرقم الأول بعد الجزء والفاصل وسوف نعتمد هذه الطريقة إن شاء الله ولذلك اريد استبدال و( باسم الكتاب حتي نستطيع إتباع نمط محدد

سؤال لو سمحت دلوقتي احنا عندنا 3 أرقام - رقم الجزء مثال 1 وفي حال كانت ص يتم استبدالها بـ 1 - رقم الصفحة وهو يأتي بنبسة 100% بعد رقم الجزء / وقدياتي حديث في صفحتي فالصفجة الاولي تاتي أولاً ومن ثم الثانية بهذه الكيفية 132-133 رقم الحديث وهو الموجود في العمود B_Hno وفق ما فهمت فقد ياتي اسم الحديث بعده اما - رقمه - او الجزء والصفحة - الصفحة - او الصفحة ويرمز لها بـ ص وقد لا يرمز لها هل من الممكن ان تجتمع الاحتمالات الثلاثة ؟ اما أفكر فيه حالياً هو ان نستهدف عن القص أبعد رقم قد يرد وليكون الرقم المستهدف هو رقم الصفحة والحمد لله قد افضنا الي دالة القص خاصية تسمح لنا بزيادة الجزء المقتطع من النص فمثلاً لو كان النص يتمن كتاب (232) - (1 / 132-133) فإذا تم قص النص برقم الصفحة 132 سنفقد باقي الحديث ولكن يمكن ان نخبر الدالة ان تزيد بعد الرقم وليكن 8 خانات أخري حتي نضمن الجزء المتبقي للبحث يتضمن كافة المعلومات التي قد نحتاج اليها ومن ثم تقوم بعمل دالة تقوم بعمل إستبدال لـ ص او (ص او ( ص بـ 1 / وتستبدل أيضاً و( او و ( باسم الحديث ( النتيجة اننا لدينا نص الان تم معالجته ولم يعد هناك أرقام تاتي في مواضع متأخرة ومن ثم يمكن تطبيق نمط لنفحص تطابق النتيجة من عدمها في انتظار مراجعتك وتعليق ودعواتك بالتوفيق

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

السلام عليكم ورحمة الله وبركاته اللهم لك الحمد كله، ولك الشكر كله، ولك الملك كله، وبيدك الخير كله، وإليك يرجع الأمر كله؛ علانيته وسره أوله وأخره، ظاهره وباطنه...لك الحمد يا مالك الملك في الأولى والآخرة، حمداً دائمًا طيبًا نقيًا مباركًا فيه؛ يملأ السماوات والأرض وما بينهما، كما ينبغي لجلال وجهك وعظيم سلطانك بسم الله ولا حول ولا قوة إلا بالله وعلي الله توكلنا وهو نعم المولى ونعم النصير كما فهمت انك ستقوم بالتمييز يدوياً ماذا لو كمنا بإعداد عمو في جدول TAB مثل wipedNass نقوم في باستبدال ص إذا جاءت منفردة او بعد ( مثلاً بـ 1/ وبهذه الطريقة نكون قد وحدنا النص كما يمكنك إعداد بعض النصوص كعينة للتجربة وإرسالها مع الإشارة الي مواضع البحث او النتائج المتوقعة حتي تتضح الفكرة أكثر عن التحديات والاحتمالات لدي فكرة وأحتاج إلي مساعدتك بجانب ما نقوم به اريد ان نستفيد من هذه البيانات كان نبدء في كل عملية بحث بتكوين قائمة بالكتب مثلاً الأن وجدنا تتطابق لإستخراج الـ MNO ماذا لو جمعنا القيم البحثية وهي اسم الكتاب والرقم وفي خطوة لاحقه سنجد ان قاعدة البيانات تحتوي علي MNO واسم كتاب ورقمه فنقوم بعمل دليل ان هذا الرقم يحتوي علي هذه الكتب طبعاً انا بفكر معاك بصوت عالي انا مش عارف انت شغال علي ايه بالظبط لكن عايز تفكر ازاي تقدر تستفيد من البيانات اللي بتوصلها بحيث متعرفش ان ممكن تحتاجها ازاي بما انك ماشي فالداتا بتحللها وتظبطها يعني قصدي ان لو في حاجه نقدر نعملها واحنا ماشين ومش هتعطلنا ممكن نعملها

السلام عليكم ورحمة الله وبركاته أخي الكريم يمكنك الاطلاع علي هذا الرابط https://www.devhut.net/how-to-crop-an-image-using-wia-in-vba/ والموقع به مكتبة رائعة

أخي الكريم تفضل هذا النمط إن شاء الله يتضمن الاحتمالات الممكنة pattern = "(?:" & bookName & "\s*[|_/\\ -]*\s*[\s*|'\(\[\{""]*" & bookNum & "[\s*|'\)\]\ -}""]*)" يتم استبداله هنا بانتظار تجربتك للعديد من الاحتمالات وإذا قمت بتنشيط هذا الجزء من نفس الكود فيمكنك اختبار الدالة هكذا وستطبع النتيجة Sub testIsBookExist() Dim inputText As String Dim bookName As String Dim bookNum As String bookName = "المطالب" bookNum = "3298" inputText = DLookup("[NASS]", "TAB", "[MNO]=33976") inputText = Replace(inputText, "(", "|(") inputText = Replace(inputText, ")", " )''") If isBookInText(inputText, bookName, bookNum) Then Debug.Print "YES" Else Debug.Print "NO" End If End Sub أرجو من الله التوفيق والسداد

مساكم الله بالخير والنور والسرور فيما يخص التطبيق 1- يبحث بإسم الكتاب من مربع النص والرقم من الجدول 2 - يبحث بإسم الكتاب فقط بدون الرقم هي فقط تجربة للأنتقال غلي المرحلة التي تليها فالتفكير كنت بفكر بصوت عالي 😄 وبعدين فكرت ان احنا ممكن نعمل نمط يتتبع اسماء الاكتب وأرقمها فممكن مثلاً في الجدول TAB نضيف عمود نستخرج في من النص الكتب الموجودة فيه بس ده هيحتاج اننا يكون معانا كل اسماء الكتب وكل الطرق اللي ممكن تورد بيها *معلومة عند إنشاء دالة تتبع النمط بـ Regex يمكن وضع أكثر من نمط كبدائل ان لم يجد هذا النمط يبحث عن أخر عموماً ده لو هيساعد معاك ممكن نشتغل عليها بس حاول توفرلي الانماط عشان ابداء اشتغل علي الدالة وأختبرها إن شاء الله وبعد كدا نشوف هنشغلها ازاي مع أسماء الكتب صورة من التطبيق الثاني : 😁 شكراً علي التوضيح ده علي الاقل في كولكشين الاستبعاد ممكن بدل ما نكتب 3 بدائل نكتب عساكر او البيهقي ده لو متاح انا بحاول اوصل الفكرة بعض الأسئلة 1- هل في قائمة بجميع الكتب وبدائلها 2- هل يوجد قائمة بأسماء الكتب وأرقامها 3- هل العمود MNOX ده موجود وانت بتحاول تصححه 4- متي سننتقل للبحث بأرقام الصفحات والاحتمالات الاخري ؟ ملحوظة : الان جميع الاكواد التي تعمل تعمد بشكل أساسي في التحقق من MNO أولاً فاذا كان موجود تنتقل اللي السجل التالي فقط إذا كان فارغاً تعمل وهذا توفيراً للوقت وخاصةً عن البحث باسم بديل فحتي لا يبدأ من جديد مع كامل القائمة يذهب فقط إلي الخانات الفارغة علي أي حال كل هذا يمكن تعديله فقد كنت حريصاً علي أنت تصل الي ما تريده وتطمئن إلي ان والحمد لله الأمر ممكن تحقيقه بفضل الله اذا كنت بحاجه إلي تعديل أي شئ فلا تتردد بالتوفيق

الأستاذة / حنان @hanan_ms قمت بعمل مديول لحساب الوفق بشكل عام وأضفت له هذه الدالة Public Function ClassifySpeed() As RequestSpeed لقياس سرعة استجابة الاتصال بالأنترنت لجلب معلومات علي سبيل المثال عن طريق oXMLHttp = CreateObject("MSXML2.ServerXMLHTTP") وبالطبع يمكن التعديل والإضافة علي القيم إذا كان هناك قاعدة لتمييز الوقت المحدد للاستجابة

السلام عليكم ورحمة الله وبركاته أخي الكريم @nssj تم بحمد الله العمل علي التعديلات المطلوب الملف بالمرفقات كما تم التعديل علي بعض الأكواد سأحاول تغطية التعديلات وإن كان هناك أي استفسار أو طلب أخر فلا تتردد بانتظار التجربة والإفادة 1- فيما يخص التعديل الأول فما أردته هو ان يتم كل شي فالبحث كما هو ولكن فقط أردت تثبيت اسم الكتاب وعليه تم التعديل في الكود نفسه ليتضمن هذا الاحتمال دون أن يتأثر القديم فكانت التعديلات هي إضافة (Optional constName As Boolean = False) حتي يتم التمييز إذا كان اسم الكتاب ثابت ام متغير وبشكل افتراضي هي False فالاختيار الأساسي هو ان الاسم متغير يعتمد علي خانة اسم الكتاب بالجدول وهذا ما تم تعديله علي الكود If constName = False Then BookName = Nz(Trim(.Fields(bookNameCol)), "") Else BookName = Trim(bookNameCol) End If كما يجب التنبيه ان هذا الكود يعتمد بشكل أساسي علي الجدول TAB ومحتوياته بما فيها wipedNass تم التعديل علي (createBooksCollection) تم إضافة تحقق إذا كان العمود الثاني موجود لإضافة ما فيه وللعلم فالمطلوب لعمل هذا الكولكشين هو جزء يميز اسم الكتاب مثال اذا كان الكتاب الاسم الأول معجم ابن عساكر والثاني ابن عساكر في معجمه فيكفي ان يكون الاسم ابن عساكر في البحث او الاستبعاد ----------------------------------------------------- فيما يخص الطلب الثاني فقد تم عمل المطلوب بهذه الطريقة Public Function isBookInText(ByVal fullText As String, _ ByVal BookName As String, _ Optional ByVal bookNum As String = "") As Boolean On Error GoTo ErrorHandler Dim regex As Object Dim matches As Object Dim match As Object Dim pattern As String Set regex = CreateObject("VBScript.RegExp") If bookNum = "" Then pattern = "(?:" & BookName & "\s*-?\s*\(\d+(?:[/\\,\-_]\d+)*\))" Else pattern = "(?:" & BookName & "\s*-?\s*\(" & bookNum & "\))" End If With regex .Global = False .MultiLine = True .IgnoreCase = False .pattern = pattern End With Set matches = regex.Execute(fullText) If Not matches Is Nothing And matches.count > 0 Then ' Debug.Print "Book(s) found in text:" ' For Each match In matches ' Debug.Print " - " & match.Value ' Next isBookInText = True Else isBookInText = False End If CleanAndExit: If Not regex Is Nothing Then Set regex = Nothing If Not matches Is Nothing Then Set matches = Nothing Exit Function ErrorHandler: Debug.Print "Error: " & Err.Description isBookInText = False Resume CleanAndExit End Function فهذه الدالة يمكن استخدامها للبحث عن الكتاب برقم او بدون رقم وهي تبحث داخل النص وفق هذه الشروط اسم الكتاب يتبعه أي عدد من المسافات - او بدون ثم أي عدد من المسافات ثم ( ثم رقم مع فواصل او بدون ثم ) إذا تم تحديد نص للرقم اسم الكتاب يتبعه أي عدد من المسافات - او بدون ثم أي عدد من المسافات ثم ( النص المحدد ) هذا السطر من الكود (.Global = False) اذا كنت تريد للبحث ان يتوقف بعد اول نتيجة تم عمل هذه الدالة لتعود بـ True or False ولكن يمكن التعديل عليها لتعود بكامل النص مثلاً او تعود بالكتب الموجودة داخل النص التي ينطبق عليها الشروط السابقة تم تطبيق فكرة هذا التعديل للبحث برقم او بدون رقم في الملف المرفق تم إضافة كود لعمل تحديث للفورم قبل التنفيذ حتي يتأثر بالمتغيرات علي مربع النص بالتوفيق Smart_Search_Nssj_V6.zip

أخي الكريم بارك الله فيك 1- عندي استعداد وربنا يقدرني ويستخدمني 2- لو ممكن توضح التعديلات المطلوبة أكتر مع أمثلة 3- نعم يمكن وضع نمط للبحث وفي هذه الحالة انت لا تستهدف أرقام الكتب التي تأتي في مواضع متأخرة حاول توضيح المطلوب اكثر مع الذكر الحالات والأمثلة وإن شاء الله سنتمكن من الوصول لحل 4- ولقد حاولت في الكود الحالي ان يتعامل مع المتغيرات فيمكنك استدعائه من أي جدول ومع أي عمودين إذا كان لديك أي استفسار فلا تتردد أخي الكريم بانتظار توضيحك بالتوفيق

لقد قمت بتعديل بسيط علي هذه الدالة حتي تتعرف أيضاً علي المسافات بين الاقواس بعد مراجعة طلبك وذلك بإضافة | \s* | للمقطع الأوسط النسخة بعد التعديل بالمرفق Public Function nssjWipeCondition(ByVal fullText As String) As String Dim regex As Object Set regex = CreateObject("VBScript.RegExp") With regex .Global = True .MultiLine = True .IgnoreCase = False .Pattern = "(\d+\s*-\s*\()([\d-/_,\s*\\]+)(\))" End With nssjWipeCondition = regex.Replace(fullText, "$1$3") If Not regex Is Nothing Then Set regex = Nothing End Function Smart_Search_Nssj_V5.zip

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

تفضل أخي الكريم تم تعديل الوظائف بالشروط الجديدة يمكنك تجربتها كما انه قد خطرت لي فكرة ستساعد بإذن الله في تسريع عمل الكود Public Function nssjWipeNumbers(ByVal fullText As String) As String Dim regex As Object Set regex = CreateObject("VBScript.RegExp") With regex .Global = True .MultiLine = True .IgnoreCase = False .Pattern = "(\d+\s*-\s*\()(\d+)(\))" End With nssjWipeNumbers = regex.Replace(fullText, "$1$3") If Not regex Is Nothing Then Set regex = Nothing End Function Public Function nssjWipeCondition(ByVal fullText As String) As String Dim regex As Object Set regex = CreateObject("VBScript.RegExp") With regex .Global = True .MultiLine = True .IgnoreCase = False .Pattern = "(\d+\s*-\s*\()([\d-/_,\\]+)(\))" End With nssjWipeCondition = regex.Replace(fullText, "$1$3") If Not regex Is Nothing Then Set regex = Nothing End Function Public Function nssjWipeAny(ByVal fullText As String) As String Dim regex As Object Set regex = CreateObject("VBScript.RegExp") With regex .Global = True .MultiLine = True .IgnoreCase = False .Pattern = "(\d+\s*-\s*\()([^)]*)(\))" End With nssjWipeAny = regex.Replace(fullText, "$1$3") If Not regex Is Nothing Then Set regex = Nothing End Function

اذا اردت ان تضيف العمود BookName2 بشكل منفصل في الجدول BOOKSLIST فلا يوجد مشكلة إن شاء الله ساعدل الوظيفة لتضيف منه ايضاً ففي هذا الامر لا يهم الترتيب ولكن يجب إضافته في الجدول BOOKS كما ذكرت سابقاً

أرجو لك من الله التوفيق أخي الكريم نبدأ من حيث انتهيت بالنسبة للأسماء البديلة يجب انت تضافي في موضعين 1- في الجدول BOOKSLIST في نفس العمود BookName لان هذا العمود هو ما يضاف للكولكشين التي تقوم باستبعاد الكتب التي تقع بين اسم الكتاب الذي نبحث عنه ورقمه ان جاء متأخراً 2- يضاف العمود BookName2 في الجدول Books وكل اسم في العمود BookName يقابله البديل الخاص به في العمود BookName2 وإذا أردت إضافة BookName3 فافعل وفق احتياجاتك وسارعي إن شاء الله إمكانية استخدام الكود مع أكثر من عمود حتي تتمكن إذا اردت إضافة بدائل في المستقبل تتمكن من استخدم الكود معها --------------------------------- بالنسبة لإمكانية التعديل علي النمط فهي متاحة إن شاء الله ولكن إريد منك حصر الاحتمالات بأمثلة ولو انت تكتبها ك حديث 217 - (123,135) مثلاً إذا كان هناك عدد للأرقام لا يقل ولا يزيد عنه إذا كنت ترغب ان يتضمن الشرط عدد مسافات معينة اريد أن أعلم الاحتمالات الممكن حتي نتمكن إن شاء الله من عمل نمط يستوعبها -------------------------------- كل الدوال التي تم مشاركتها يمكنك استخدامها منفردة ويمكن ان تستخدمها للتعديل علي النص الحالي او إنشاء عمود جديد معدل فيما عدا الدالة التي سبق وذكرت انها بحاجه لرقم حتي تبحث عنه وتطابقه وتمسحه ----------------------------- بالتوفيق

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

الحمد لله والشكر لله بالتوفيق أخي الكريم هذه الدالة (wipeValueFormString) لا تعمل هكذا فهي بحاجه الي رقم بعينة حتي تبحث عن وتطابقه ثم تحذفه وبالتالي لن تعمل بشكل عام فتستخدم هكذا wipeValueFormString([nass],"25") ولكن قد قمت بفضل الله بعمل ثلاث دوال أخرى تطابق الشروط التالية تبحث عن - متبوعة بأي عدد من المسافات ثم ( وبعد ذلك يوجد محتوي كل دالة تتعامل مع المحتوي بشكل مختلف ثم ) مثال علي أحد الدوال وفرصة لعرض إمكانية Regex في التحقق من نمط بداخل نص وانا لم أتعمق كثيراً في استخدامتها ولكن أحتجتها قريباً وبدأت اقراء عنها وغالباً ما اعتمد فالبحث وأدوات الذكاء مؤخراً حتي أصل للنمط المناسب حتي وانا أبحث هذه المرة تعرفت علي معلومة جديد Public Function wipeNumbersInCondition(ByVal fullText As String) As String Dim regex As Object Set regex = CreateObject("VBScript.RegExp") With regex .Global = True .MultiLine = True .IgnoreCase = False .Pattern = "(-\s*\()(\d+)(\))" End With wipeNumbersInCondition = regex.Replace(fullText, "$1$3") If Not regex Is Nothing Then Set regex = Nothing End Function Public Function wipeAllInCondition(ByVal fullText As String) As String Dim regex As Object Set regex = CreateObject("VBScript.RegExp") With regex .Global = True .MultiLine = True .IgnoreCase = False .Pattern = "(-\s*\()([\d/-]+)(\))" End With wipeAllInCondition = regex.Replace(fullText, "$1$3") If Not regex Is Nothing Then Set regex = Nothing End Function Public Function wipeAnyInCondition(ByVal fullText As String) As String Dim regex As Object Set regex = CreateObject("VBScript.RegExp") With regex .Global = True .MultiLine = True .IgnoreCase = False .Pattern = "(-\s*\()([^)]*)(\))" End With wipeAnyInCondition = regex.Replace(fullText, "$1$3") If Not regex Is Nothing Then Set regex = Nothing End Function فالأكواد الثلاثة كلها تتبع نفس النمط وفق ما ذكرت سابق ولكن تختلف كل واحدة في تميز المحتوي 1- wipeNumbersInCondition تحذف المحتوي إذا كان ارقام فقط 2- wipeAllInCondition تحذف المحتوي إذا ارقام / ارقام 3- wipeAnyInCondition تحذف المحتوي مهما كان مثال إذا أردت التعديل علي النمط حتي لا يبحث عن عدد لا نهائي من المسافات بين الـ - والـ ( اريدة فقط ان يبحث عن مسافة واحدة او بدون مسافات كل ما علي فعله هو أستبدال \s* بـ \s? في النمط "(-\s*\()(\d+)(\))" حيث ان ؟ تعني بدون مسافة او مسافة واحد والمعلومة الجديدة التي تعلمتها هي هنا تتم عملية الاستبدال للنمط المطابق regex.Replace(fullText, "$1$3") ومن الممكن ان يتم الاستبدال هكذا regex.Replace(fullText, "-()") ولكن $1 يشير إلي أول جزء في النمط و $3 تشير الي الجزء الثالث في النمط وبتالي ستيم الاستبدال بالقبم الملتقطة فلن يتغير اي شي علي النص فقط المحتوي ما بين الـ () يمكنك استخدام أي واحدة من الدوال الثلاثة بالطريقة التي ذكرتها كما يمكنك أختيار واحدة منهم لأضعها فالكود المستخدم بدلاً من تحديد رقم بعينة إذا أردت ذلك ------------------- بالنسبة للكود الذي سيعمل بإذن الله علي اسم الكتاب الأخر كنت أفضل لو تشارك نموذج به مثال حتي أتمكن من معاينة النتيجة وأيضاً حتي يوافق الكود التكوين الخاص بك والاسماء اما إذا أردت ان أضيف عمود وأم انا بالتسمية و ،،، فسوف أعمل عليه إن شاء الله بانتظار إجابتك

النص بعد حذف الأرقام أصبح مصنفات البختري (15)، و269 - () حدثنا محمد .. اليك النسخة بالمرفقات Smart_Search_NSSJ_V2.accdb