بحث مع تلوين الحروف

[jo_2010]

السادة الخبراء الافاضل

بعد التحية 

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

وجدت نموذج بحث جميل فى هذا المنتدى الرائع منذ فترة واود التعديل علية لكنى لا اعرف لذلك ارجو المساعدة 

عند البحث مع اختيار طريقة البحث تحديد يظهر كما بالصورة  2   وهذا رائع

 ولكن عند اختيار طريقة البحث تصفية يقوم بتصفية النموذج كما بالصورة 3

الذى اريدة هو عند اختيار تصفية يتم تلوين كل حرف يكتب فى مربع البحث باللون الاحمر  كما بالصورة 1

اليكم القاعدة للتعديل عليها   لكم الشكر

LAB_2023.accdb

[jo_2010]

هل طلبى صعب ام مستحيل ارجو الافادة 

[AbuuAhmed]

أعتقد (غير متأكد) ولكن على السجل الحالي فقط ولكلمة واحدة فقط أيضا، بمعنى لو حقل الاسم يحتوي على اسم أحمد مرتين سيظلل الاسم الأول فقط.
لم أحاول ولا أستطيع فتح قاعدة بياناتك لآن نسختك أحدث من نسخة الأكسس عندي.

يمكن الزملاء التجارب مع هذه الخصائص:
SelText
SelStart
SelLength

[AbuuAhmed]

تطبيق الفكرة

SearchSel_01.accdb

[ناقل]

تفضل <<<<<<<<>>>>>>>>>

في 11‏/4‏/2018 at 12:50, أبو آدم said:

إخوتي الفضلاء

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

حيث طرح السؤال و الطلب ضمن مشاركة احد الاخوة في موضوع يتعلق بالبحث  ، بالاضافة لطرح هذا الطلب اكثر من مرة في مواضيع مختلفة .

حاولت جعل الكودات بسيطة و قابلة للتعديل حسب التطبيقات التي سيستخدم بها منعا لحدوث اشكالات عند النقل و التطبيق .

هناك امور لا بد من مراعاتها عند التعامل مع الفكرة و بعضها رئيسي ومهم لا تنجح الامور الا به ،  و هي كما يلي :

·        نص البحث يكتب ضمن مربع النص txtSearch

·        البحث و الفلترة تتم في نفس النموذج و هو نموذج مستمر و ليس من خلال نموذج فرعي او مربع قائمة

·        البحث سيتم ضمن ثلاثة حقول من الجدول tblCustomer ، وهي CompanyName و City و Address يمكن زيادتها حسب الحاجة و مستلزمات التطبيق

·        مربعات النص في النموذج التي تظهر محتويات الحقول هي غير منضمة unbound

·        مصدر عنصر التحكم control source للحقول يثبت لكل مربع نص ضمن قائمة الخيارات مثلا (=[CompanyName])

·        مربعات النص الثلاثة يجب ان يكون تنسيق النص فيها text format هو (Rich Text) ،  وهذه نقطة مهمة حتى يقبل مربع النص كود تغيير خصائص أجزاء النص من حيث اللون و الخط العريض .

·        كود البحث و الفلترة يكون خلف حدث on change – عند التغيير لمربع النص txtSearch

·        البحث و الفلترة يفترض في فكرتنا ان تتم عند كل حرف ، وبعد انتهاء الفلترة يعود مؤشر النص ليكتب نص ( حرف ) الفلترة الجديد ، فيصبح مربع النص يتعامل من حرف واحد فقط ، وبالتالي سنضطر لاستخدام خاصية SelStart لتحدد نقطة البداية للنص أو موضع نقطة الإدراج لنتمكن من كتابة اكثر من حرف .

·        بعد التطبيق اعترضتني مشكلة عدم قبول مربع النص للمسافة بين الاحرف spacebar ، نتيجة استخدام خاصية SelStart  و بالتالي كان لا بد من إجبار مربع النص على قبول المسافة بين الاحرف ، و تم ذلك و الحمد لله باستخدام كود في حدث on Key up .

·        ضمن الكود تم تحديد خاصيتين للخط و هما اللون الاحمر و الخط العريض وذلك لتمييز مكانها ضمن نتائج البحث و الفلترة .

·        كل حرف يتم كتابته في مربع النص  txtSearch  تتم بموجبه و مباشرة فلترة النتائج ضمن مربعات النص الثلاثة و تمييز الحرف باللون الاحمر العريض.

·        بعد الفلترة يتم تغيير مصدر عنصر التحكم عبر الكود باسناد القيم لمربعات النص الثلاثة في النموذج محملة بكود تغيير خصائص الخط لكل حرف تمت كتابته في مربع النص txtSearch

·        بالضغط على مربع النص txtSearch يتم افراغ مربع النص مما كتب به سابقا لبداية بحث جديد ، كما تظهر كافة سجلات الجدول في مربعات نص النموذج.

راجيا من الله عز و جل ان يكون التطبيق وافيا و محققا لحاجات الاخوة ، و ان يكون فيه النفع لهم في تطبيقاتهم .

و الله من وراء القصد ...

NA_Highlight_Search_results_while_typing.accdb

 

[jo_2010]

خالص الشكر لحضرتك مجهود يحترم ممكن اضافة تلوين خلفية البحث

[AbuuAhmed]

في 27‏/6‏/2023 at 08:50, jo_2010 said:

خالص الشكر لحضرتك مجهود يحترم ممكن اضافة تلوين خلفية البحث

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

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

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

وكل عام وأنتم بخير.

[mrbakr]

رائع

[AbuuAhmed]

جرب الآن
طبعا بالتلوين يمكن عمل التالي:
- تكرار للبحث عن الكلمة المراد تلوينها في السجل الواحد.
- تكرار للبحث عن الكلمة في جميع السجلات.
 

SearchSel_02.accdb

[jo_2010]

كل سنة وحضرتك طيب وبخير عيد سعيد

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

[AbuuAhmed]

8 ساعات مضت, jo_2010 said:

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

أساسا مثالك الأصل هو تنسيق شرطي وعيبه أنك لا تستطيع تلوين أكثر من كلمة ضمن الحقل.

ثم عملت لك فكرة التظليل وعيبه أنك لا تستطيع تظليل الكلمة في كل السجلات دفعة واحدة.

ثم عملت لك فكرة التلوين وعيبه أنك لا بد لك أن تستخدم حقل مذكرة في الجدول.

هذا كل ما يستطيع أن يوفره الأكسس وفقا لخبرتي القديمة مع نسخ الأكسس القديمة، هل هناك جديد مع النسخ الجديدة؟ أنتم أعلم مني، ننتظر مشاركة الزملاء.

وكل عام وأنت بخير.

تم تعديل يونيو 30, 2023 بواسطه AbuuAhmed

[jo_2010]

استاذى الفاضل 

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

color.accdb

[AbuuAhmed]

هل تستطيع تحويل المرفق إلى إصدار 2003؟
مع تصوري أنه لن يضيف شيئ على ما سبق عرضه في هذا الموضوع.

[jo_2010]

حاولت ولم اتمكن

[jjafferr]

3 ساعات مضت, AbuuAhmed said:

هل تستطيع تحويل المرفق إلى إصدار 2003؟

تفضل يا سيدي ، تم حذف الحقول المحسوبة في الجدول 🙂

 

color.zip

 

وقد تستفيد من الخطوة التي قمت بها :

=IIf(IsNull([Forms]![3_JO_Search]![txtSearchText]),[اسم المريض],Replace([اسم المريض], [Forms]![3_JO_Search]![txtSearchText], "<b><font color = red >" & [Forms]![3_JO_Search]![txtSearchText] & "</font></b>"))

 

[AbuuAhmed]

4 دقائق مضت, jjafferr said:

تفضل يا سيدي ، تم حذف الحقول المحسوبة في الجدول 🙂

شكرا عزيزي
The database you are trying to open requires a newer version of Microsoft Access

لا زلت لا أستطيع فتح قاعدة البيانات.

[jjafferr]

وانزلتها الى صيغة اكسس 2000 🙂

color2.zip

[AbuuAhmed]

لم يأني في خلدي فكرة عمل الصندوق مع الاستعلام.
فكرة جميلة جدا، مثال تعلمت منه الجديد المفيد اليوم.

المثال بعد تطبيق الفكرة الجديدة.

SearchSel_03.accdb

[AbuuAhmed]

الأفكار تتدافع للاستفادة من الفكرة الجديدة، الآن الدلة تلون أكثر من كلمة في الحقل الواحد.

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

Function RichText(ByVal sText As Variant, ByVal sWord As Variant) As String
    Dim lStr As String
    Dim rStr As String
    Dim sPos As Integer
    
    sText = Nz(sText, "")
    sWord = Nz(sWord, "")
    
    lStr = "<font color=red>"
    rStr = "</font>"
    
    sText = Replace(sText, lStr, "", 1)
    sText = Replace(sText, rStr, "", 1)

    sPos = InStr(1, sText, sWord)
    Do While sPos > 0
        sText = Left(sText, sPos - 1) & _
                lStr & sWord & rStr & _
                Mid(sText, sPos + Len(sWord))
        sPos = InStr(sPos + Len(sWord & lStr), sText, sWord)
    Loop
    
    sText = Replace(sText, rStr & " " & lStr, " ", 1)
    sText = Replace(sText, rStr & "" & lStr, "", 1)
    
    RichText = sText
End Function

 

SearchSel_04.accdb

تم تعديل يوليو 1, 2023 بواسطه AbuuAhmed

[jjafferr]

ممتاز 🙂

بس سؤال: ليش تستخدم Pos لمكان بداية الكلمات ، هل Replace ما يكفي؟

شفت الكود اطول في النسخة 4 ، بس ما عرفت شو الفرق في النتيجة ، فيا ريت تخبرنا 🙂

ويا ريت تترك لنا ملاحظاتك في الكود ،خصوصا انه قصير 😁

 

جعفر

[AbuuAhmed]

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

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

Function RichText(ByVal sText As Variant, ByVal sWord As Variant) As String
    Dim lStr As String
    Dim rStr As String
    Dim sPos As Integer
    
    'للتخلص من القيمة null
    sText = Nz(sText, "")
    sWord = Nz(sWord, "")
    
    'لتكرار استخدام عبارتي حصر اللون وضعناهما في متغيرين
    lStr = "<font color=red>"
    rStr = "</font>"
    
    'لإزالة التنسيق القديم من حقل المذكرة
    sText = Replace(sText, lStr, "", 1)
    sText = Replace(sText, rStr, "", 1)
    
    'تكرار لتلوين جمعيع الكلمات في الحقل الواحد
    sPos = InStr(1, sText, sWord)
    Do While sPos > 0
        sText = Left(sText, sPos - 1) & _
                lStr & sWord & rStr & _
                Mid(sText, sPos + Len(sWord))
        sPos = InStr(sPos + Len(sWord & lStr), sText, sWord)
    Loop
    
    'لاحتصار النص وخصوصا لحقل المذكرة بإزالة تكرار عبارات الحصر للون
    sText = Replace(sText, rStr & " " & lStr, " ", 1)
    sText = Replace(sText, rStr & "" & lStr, "", 1)
    
    RichText = sText
End Function

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

تم تعديل يوليو 1, 2023 بواسطه AbuuAhmed

[AbuuAhmed]

وهذه الدالة بعد تقليل أسطرها وتبديل التكرار باستخدام دالة replace

Function RichText(ByVal sText As Variant, ByVal sWord As Variant) As String
    Dim lStr As String
    Dim rStr As String
    
    sText = Nz(sText, "")
    sWord = Nz(sWord, "")
    
    lStr = "<font color=red>"
    rStr = "</font>"
    
    sText = Replace(Replace(sText, lStr, "", 1), rStr, "")
    sText = Replace(sText, sWord, lStr & sWord & rStr, 1)
    sText = Replace(Replace(sText, rStr & " " & lStr, " ", 1), rStr & "" & lStr, "", 1)
    
    RichText = sText
End Function

 

[jjafferr]

شكرا جزيلا ابو احمد 🙂

[mrbakr]

Great