Ahmos

تفضلي أستاذة / حنــان الملف بالمرفق جميع الاكواد المضافة والمعدلة داخل مديول (New_Functions_Subs) الصورة : بعد القص : بعد تعديل المقاس : Cropping_Images_V1.zip

لو محتاجه تعمليها بدون التعديل علي واجهة البرنامج ممكن نعملها لكن في تفاصيل لازم نجاوب عليها 1- الـ Sub_Form بيفتح باستعلام معني كدا ان محتوي الفورم نفسة فالغالب هيتغير كل مرة 2- فالحالة دي هنحتاج نميز كل سجل هل تم طباعته ام لا ودي ممكن نوصلها " إن شاء الله " نضيف عمود في الجدول 3- وممكن نضيف عمود كمان عشان عدد مرات الطباعة 4- هل هنحتاج نضيف حد أقصي وأين سنضيفه في الكود أم في الواجهة ؟ محتاج أعرف احتياجك بالظبط وإن شاء الله ربنا يوفقنا ونوصل للمطلوب الحمد لله والشكر لله بالتوفيق

الملف المعدل بالمرفقــات *ملحوظة أكواد الطباعة الموجودة خـاصة بطابعة الـ SUB_FORM في حال كان هناك تقرير ستختلف أكواد الطباعة Safaa_New.accdb

اللي فهمته 1- سيتم عمل اسكان لورقة 2- تريدي قص هذه الصورة لاستبعاد الأجزاء الغير مرغوب بها 3- تغير مقاس هذه الصورة فيما يخص النقطة رقم 2 - إذا أمكن مشاركة صورة للتجربة - حسب تصوري يجب أولاً معرفة جودة هذه الصورة حتي نتمكن من حساب البكسلز ومعرفة كيفية حساب الجزء المستبعد ثم قص الصورة فيما يخص النقطة رقم 3 فهمت من الصور ان المقاس المرغوب هو 8.5 * 11 بوصة(انش) وليس سم *ملحوظة هذا المقاس ليس A4 إنما US Letter Size A4 > 8.3 * 11.7 بوصلة A4 > 21 * 29.7 سم

السلام عليكم ورحمة الله وبركاته الأستاذة صفاء يمكنك إضافة الكود التالي في الحدث عند النقر او في Public sub واستدعائه Dim msgResponse As VbMsgBoxResult Dim totalRecords As Integer Dim totalSeeReport As Integer Dim totalNotEmptyResult As Integer Dim totalEmptyResult As Integer Dim tableName As String tableName = "test_order_tbl" totalRecords = DCount("*", tableName) If totalRecords = 0 Then MsgBox "There are no records in Table : " & tableName, vbCritical + vbOKOnly, "Error : No Records" Exit Sub End If totalSeeReport = DCount("[see_report]", tableName, "[see_report]=false") totalNotEmptyResult = DCount("[see_report]", "test_order_tbl", "[see_report]=false and not isnull([result])") totalEmptyResult = DCount("[see_report]", "test_order_tbl", "[see_report]=false and isnull([result])") If totalSeeReport = totalEmptyResult Then MsgBox "No need To Print this Report", vbInformation + vbOKOnly, "No Need To Print" Exit Sub ElseIf totalSeeReport = totalNotEmptyResult Then ' Here you shuold add the print code to print all records Debug.Print "Report Printed" Else msgResponse = MsgBox("Only Some Results Exist" & vbCrLf _ & "Do you want to Print The report ?", vbQuestion + vbYesNo, "Do You want to Print ?") If msgResponse = vbYes Then ' Here you shuold add the print code to print all records Debug.Print "Report Printed" Else Debug.Print "Report will not be Printed" End If End If اما بخصوص هل تم طباعته من قبل وحتي لا نضيف أي شي لواجهة البرنامج فاقتراح إضافة عمود بالجدول او اثنين 1- نعم او لا إذا تم الطباعة 2- لعدد مرات الطباعة إذا كان هذا الاقتراح مناسب فيمكنك التعديل علي الملف ومشاركته مرة أخرى وإن شاء الله سأضيف الاكواد اللازمة لتحديثه

الدالة بالفعل تبحث باسم الكتاب والرقم إذا امكنك تزويدي بمكتبة كبيرة او واحدة تضمن بعض الأمثلة كما ان فكرة استبدال الاسم بالفعل فكرة ممتازة اذا كنت تملك قاعدة بهذه الأسماء وبدائلها فيمكن العمل علي دالة تقوم بهذا الاستبدال كما يمكن أيضاً إعداد نص أخر سوف أقوم "إن شاء الله" باستبدال الاسم بوضعه داخل علامات مميزة مثال الأربعين في مناقب أمهات المؤمنين يصبح (BN) الأربعين في مناقب أمهات المؤمنين (BN) بشرط ان هذه العلامة لا توجد بالاحاديث وبهذه الطريقة يمكن عمل دالة تستخرج جميع الاحاديث داخل النص 1- عمل دالة لاستبدال جميع بدائل الأسماء لتوحيد الاسم داخل النص 2- استبدال (ص 3- يجب معالجة المواضع المتأخر بإيجاد طريقة لاستبدال و( باسم الحديث الذي يأتي قبلها 4- عمل دالة تتبع النمط التالي (BN) كلام (BN) مسافة او أي فواصل ( { وهكذا ثم ارقام ثم إلي أخر رقم او ) وبهذه الطريقة سيكون لدينا جميع الاحاديث داخل هذا النص ومن ثم يمكن التفكير في طريقة للعمل عليها وتحليلها بالتفكير فالنقطة رقم 3 فيمكن إن شاء الله عمل دالة تبحث قبل الـ و( حتي تصل إلي (BN) ثم تستبدل أسأل الله التوفيق والسداد

الحمد لله والشكر لله أخي الكريم التعديل علي رأس الدالة يعني التعديل علي القيم الافتراضية فقط بمعني وضع كلمة 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