البحث في الموقع

بحث متعدد امكانية اختيار حقل او حقول بحث من خلال كود مركزى فى وحدة نمطية لتطبيق فكرة البحث فى اكثر من نموذج أقدم لكم وحدة نمطية عامة جاهزة للاستخدام تحول اى نموذج إلى محرك بحث تفاعلى بمميزات احترافية تدعم: البحث فوري أثناء الكتابة (Search As You Type) تلوين HTML للكلمات المطابقة للنتائج بلون أحمر <font color=red> بحث متعدد الحقول بحث متعدد الكلمات دعم كامل للحالات المتقدمة "ط" ← تلوين "ط" في كل الحقول "ط ر ة" ← تلوين "ط" + "ر" + "ة" مع فلتر AND "ط " ← مسافة محفوظة (تلوين فقط) Backspace/Delete ← فلتر يتجدد النقر المزدوج - Double Click ← مسح فورى بحث بدون نتائج ← رسالة + إلغاء فى حالة عدم وجود نتائج الوحدة النمطية العامة مثلا باسم : modMultipleSearchHighlights Option Compare Database Option Explicit Private Const CTRL_PREFIX As String = "txt" Public Sub InitUniversalSearch(frm As Form, fieldNames As String) On Error GoTo ErrHandler Dim arr() As String: arr = Split(fieldNames, ",") Dim i As Integer, fld As String For i = 0 To UBound(arr) fld = Trim(arr(i)) frm.Controls(CTRL_PREFIX & fld).ControlSource = "=[" & fld & "]" Next i Exit Sub ErrHandler: MsgBox "خطأ في InitUniversalSearch: " & Err.Number & " - " & Err.Description & vbCrLf & "الحقل: " & CTRL_PREFIX & fld, vbCritical, "خطأ في البحث" End Sub Public Sub UpdateSearch(txtBox As TextBox, frm As Form, fieldNames As String) On Error GoTo ErrHandler Dim searchValue As String Dim currentPos As Long searchValue = txtBox.text currentPos = Len(searchValue) If Len(searchValue) = 0 Then ResetAllHighlights frm, fieldNames frm.FilterOn = False ElseIf Right(searchValue, 1) = " " Then ApplyHighlightsOnly frm, fieldNames, searchValue Else ApplyHighlightsOnly frm, fieldNames, searchValue frm.Filter = BuildFilterSQL(fieldNames, searchValue) frm.FilterOn = True If frm.Recordset.RecordCount = 0 Then MsgBox "لا توجد نتائج لـ """ & searchValue & """" & vbCrLf & "عدد السجلات: 0", vbInformation, "نتائج البحث" frm.FilterOn = False End If End If Dim wasFocused As Boolean: wasFocused = (Screen.ActiveControl.name = txtBox.name) txtBox.SetFocus txtBox.SelStart = currentPos txtBox.SelLength = 0 If Not wasFocused Then Screen.PreviousControl.SetFocus Exit Sub ErrHandler: Select Case Err.Number Case 2185 Debug.Print "UpdateSearch 2185 ignored: " & Err.Description Resume Next Case 2474, 6139 Debug.Print "UpdateSearch ignored: " & Err.Number & " - " & Err.Description Resume Next Case Else Debug.Print "UpdateSearch Error: " & Err.Number & " - " & Err.Description MsgBox "خطأ في البحث: " & Err.Number & vbCrLf & Err.Description, vbCritical Resume ExitHandler End Select Resume Next ExitHandler: End Sub Private Function ReplaceMultiple(inputText As String) As String Dim result As String: result = inputText result = Replace(result, "'", "''") result = Replace(result, "[", "[[]") result = Replace(result, "?", "[?]") result = Replace(result, "*", "[*]") result = Replace(result, """", """""") ReplaceMultiple = result End Function Private Sub ApplyHighlightsOnly(frm As Form, fieldNames As String, searchText As String) Dim arr() As String: arr = Split(fieldNames, ",") Dim words() As String: words = Split(searchText, " ") Dim i As Integer, w As Integer, fld As String Dim ctrl As Control, expr As String, safeWord As String On Error GoTo ErrHandler Application.Echo False For i = 0 To UBound(arr) fld = Trim(arr(i)) Set ctrl = frm.Controls(CTRL_PREFIX & fld) On Error Resume Next Do While ctrl.FormatConditions.Count > 0 ctrl.FormatConditions(1).Delete Loop On Error GoTo ErrHandler expr = "Nz([" & fld & "], """")" For w = 0 To UBound(words) If Len(Trim(words(w))) > 0 Then safeWord = ReplaceMultiple(Trim(words(w))) expr = "Replace(" & expr & ",""" & safeWord & """,""<font color=red>" & safeWord & "</font>"")" End If Next w ctrl.ControlSource = "=IIf(Len(" & expr & ")>0, " & expr & ", """")" Next i Application.Echo True Exit Sub ErrHandler: Application.Echo True Debug.Print "ApplyHighlightsOnly Error: " & Err.Number & " - " & Err.Description & " (Field: " & fld & ")" End Sub Private Sub ResetAllHighlights(frm As Form, fieldNames As String) Dim arr() As String: arr = Split(fieldNames, ",") Dim i As Integer, fld As String, ctrl As Control On Error GoTo ErrHandler Application.Echo False For i = 0 To UBound(arr) fld = Trim(arr(i)) Set ctrl = frm.Controls(CTRL_PREFIX & fld) On Error Resume Next Do While ctrl.FormatConditions.Count > 0 ctrl.FormatConditions(1).Delete Loop On Error GoTo ErrHandler ctrl.ControlSource = "=[" & fld & "]" Next i Application.Echo True Exit Sub ErrHandler: Application.Echo True Debug.Print "ResetAllHighlights Error: " & Err.Number & " - " & Err.Description End End Sub Private Function BuildFilterSQL(fieldNames As String, searchText As String) As String On Error GoTo ErrHandler Dim arrFields() As String: arrFields = Split(fieldNames, ",") Dim words() As String: words = Split(searchText, " ") Dim conditions As String, i As Integer, w As Integer Dim wordCond As String, safeWord As String For w = 0 To UBound(words) If Len(Trim(words(w))) > 0 Then safeWord = ReplaceMultiple(Trim(words(w))) wordCond = "" For i = 0 To UBound(arrFields) If i > 0 Then wordCond = wordCond & " OR " wordCond = wordCond & "[" & Trim(arrFields(i)) & "] Like '*" & safeWord & "*'" Next i If Len(conditions) > 0 Then conditions = conditions & " AND " conditions = conditions & "(" & wordCond & ")" End If Next w BuildFilterSQL = IIf(Len(conditions) = 0, "", conditions) Exit Function ErrHandler: BuildFilterSQL = "" Debug.Print "BuildFilterSQL Error: " & Err.Number & " - " & Err.Description End Function إعدادات النموذج المطلوبة مربع نص البحث باسم : txtSearch مربعات نص الحقول المطلوب البحث بداخلها : يجب ان تكون غير منضمة : Unbound يجب ان تكون Rich Text يجب ان تكون بنفس اسم الحقل تماما وتسبقها البادئة : txt فمثلا فى المرفق الحقول المطلوب البحث بداخلها كانت باسم :item_na, class_no اذن اسماء مربعات النص فى النموذج لتلك الحقول سوف تكون بالاسماء: txtitem_na, txtclass_no مصدر بيانات النموذج (Record Source) :اسم الجدول او استعلام للجدول عادى Query/Table الاكواد المطلوبة فى النموذج ثابت لادراج اسماء الحقول المراد البحث بداخلها مثل Private Const strUniversalfieldNames As String = "item_na,class_no" وفى حدث تحميل النموذج Private Sub Form_Load() InitUniversalSearch Me, strUniversalfieldNames End Sub أحداث مربع النص الخاص بالبحث : txtSearch يمكن استخدام حدث عند التغيير (Change) أو حدث بعد التحديث (AfterUpdate) ولكن الافضل فى السرعة والاداء خاصة مع كثرة عدد السجلات او عند استخدام التطبيق فى شبكة محلية لضمان الكفائة فى الاداء والسرعة يفضل استخدام الكود التالى فى حدث بعد التحديث (AfterUpdate) UpdateSearch Me.txtSearch, Me, strUniversalfieldNames ولكن انا فقط فى المرفق استخدمت حدث عند التغيير لرؤية النتيجة فورية فقط وبعد ذلك يمكن عمل زر امر لعمل مسح للفلاتر ولمربع النص او كود فى حدث النقر المزدوج لمربع البحث : txtSearch Me.txtSearch.Value = "" UpdateSearch Me.txtSearch, Me, strUniversalfieldNames واخيرا المرفق Search Highlights.accdb

السلام عليكم ورحمة الله تعالى وبركاته هذا المرفق نزولا على رغبة اخ كريم Filter Utility.accdb

السلام عليكم رداً على السؤال التالي: سؤال عن كود البحث في جدولين قمت بعمل محاولة بناء على ما تبين لي من مقصد السائل، وبناء على ملاحظة الأستاذ @د.كاف يار عن كون الفكرة مبتكرة، أعيد رفع المرفقات مع شرح مختزل للفكرة عارٍ من الصور، مع إضافة طريقة أخرى. الفكرة قد تحتاج إلى تهذيب بحكم أنها كانت استجابة عفوية للسائل، أضعها بين أيديكم الغالية، عسى أن يُستفاد منها: أللهم صلِ على سيدنا محمد وعلى آله وصحبه وسلم. تنقسم الطريقة إلى جزئين رئيسيين، الأول منهما ثابت والثاني اقترحت طريقتين له: الجزء الأول: عمل استعلام توحيد بين الجدول الرئيسي والفرعي، يكون فيه من الجدول الفرعي Figlio : 1- الحقل الذي نرغب بالبحث ضمنه. 2- حقل المتسلسل. 3- حقل الربط. ومن الجدول الرئيسي Padre: 1- الحقل الذي نرغب بالبحث ضمنه 2- حقل المتسلسل 3- حقل محسوب قيمته صفر (نستحصل عليها بضرب حقل المتسلسل بالقيمة صفر). بالنسبة لي، قد اخترت أن يكون في نموذج البحث مربع قائمة -على مبدأ (البحث عن الكل) في الإكسل- يكون مصدره الاستعلام الذي سميته في الأنموذج المرفق (SearchQ)، وربطته بفلاتر تُستدعى بناء على معيار حقل البحث (طريقة العرض يمكن تغييرها والتفنن بها وهذه الجزئية ليست موضوع المنشور)، بعد ذلك يتم الانتقال من نموذج البحث إلى نموذج الإدخال (بقسمين الرئيسي والفرعي) بتمرير قيمة حقل الربط وحقل المتسلسل. إلى مربعين غير مرتبطين في نموذج البحث ومن ثم إلى نموذج هدف البحث. (ويمكن ذلك باستخدام المتغيرات). ملحوظة: يوجد في النموذج الفرعي حقل خفي مصدره المتسلسل في الجدول الفرعي. الجزئية الثانية: كيفية تحديد الحقل والسجل الذي يتضمن الهدف! هنا لدينا طريقتان: الأولى: بنقل التركيز إلى الحقل المطلوب : Dim Padre As Integer ' متغير باسم (الأب) لحفظ قيمة معرف السجل في الجدول الرئيسي Dim Figli As Integer ' متغير باسم (الابناء) لحفظ قيمة معر السجل في الجدول الفرعي Padre = Me.id ' حقل خفي في نموذج البحث Figli = Me.ID2 ' حقل خفي في نموذج البحث If Me.ID2 = 0 Then ' هذا الشرط لجعل الكود يتحقق بالانتقال ووقوف في النموذج الرئيسي أو الانتقال ومتابعة البحث في النموذج الفرعي DoCmd.OpenForm "form1" ' إعادة فتح النموذج الهدف لنقل التركيز إليه DoCmd.GoToRecord acDataForm, "Form1", acGoTo, Padre ' فتح النموذج على السجل المنشود DoCmd.GoToControl "[اسم رب العائلة]" ' التركيز على حقل فيه Else DoCmd.OpenForm "form1" DoCmd.GoToRecord acDataForm, "Form1", acGoTo, Padre 'Me.id DoCmd.GoToControl "SubForm" ' نقل التركيز إلى النموذج الفرعي DoCmd.GoToControl "[الاسم]" ' نقل التركيز إلى حقل في النموذج الفرعي ' هذا الجزء لنقل التركيز في النموذج الفرعي إلى السجل المطلوب Dim rstt As dao.recordset Dim rstrng As String rstrng = "[id0]=" & Figli 'Forms!search!Figli Set rstt = Forms!form1!Subform.Form.RecordsetClone rstt.FindFirst rstrng Forms!form1!Subform.Form.Bookmark = rstt.Bookmark Set rstt = Nothing End If الثانية: باستخدام التنسيق الشرطي وهي الطريقة الأفضل برأيي. ويزاد فيها وجود معادلة للتنسيق الشرطي لحقل الهدف في النموذج الرئيسي وأخرى لحقل الهدف في النموذج الفرعي ، ووجود حقلين خفيين في النموذج الرئيسي يأخذان قيمتها من المتغيرين (الأب) و(الأبناء)، ستكون قيمتهما هي محددات معادلتي التنسيق الشرطي. ' سيبدو الكود بهذه الطريقة Dim Padre As Integer Dim Figli As Integer Padre = Me.id Figli = Me.ID2 Forms!form1!CondScnd.Value = Figli ' هنا نجعل حقل المعيار للتنسيق الشرطي يأخذ قيمته من المتغيرات المبين معناها في الكود السابق Forms!form1!CondFrst.Value = Padre DoCmd.GoToRecord acDataForm, "Form1", acGoTo, Padre Forms!form1.Refresh ' مع اختصار المراحل ' وتوفير ضرورة إعادة التركيز إلى نموذج البحث مع كل انتقال إلى الهدف أرجو ممن يعرج على الموضوع التفضل بوضع ملاحظاته أو اقتراحاته أو إضافته. والحمد لله رب العالمين أخيراً المثال من وضع السائل في الرابط المذكور أعلاه (مشكوراً مأجوراً إن شاء الله تعالى) Search in Main form and Sub Form Simultaneously Search_MaiForm_SubFormConditionl.accdb Search_MainF=SubFormSetFocus.accdb

السلام عليكم ورحمة الله وبركاته الاستعلام يُعتبر العمود الفقري لقواعد البيانات ، وكلما زادت معرفتنا به ، كلما يصبح البرنامج افضل واسرع 🙂 البحث/التصفية في الاستعلام من الطرق المهمة ، ولكن وللأسف الشديد ، ارى الكثير من المبرمجين لا يعرفون الطريقة الصحيحة في عملها ، فالطريقة الغير صحيحة قد تعطيك النتائج ولكن على حساب وقت تنفيذ الاستعلام 😞 الامثله هنا تقوم على انه يوجد لدينا نموذج اسمه frm_Main ، وبه حقل الاسم fName ، وحقل التاريخ:من Date_From ، وحقل التاريخ:الى Date_To ، والحقول في الاستعلام ، حقل الاسم fName ، وحقل التاريخ DateX . 1. اذا اردنا البحث عن اسم كامل (وليس جزء من اسم) ، فيجب ان يكون المعيار في الاستعلام: [forms]![frm_Main]![fName] 2. واذا كان حقل الاسم فارغا في النموذج ، ونريد ان نرى جميع الاسماء ، فالمعيار يصبح: iif(len([forms]![frm_Main]![fName] & '')=0,[fName],[forms]![frm_Main]![fName]) والشرح للتأكد بأن الحقل فارغ في النموذج، بدل ان نكتب IsNull([forms]![frm_Main]![fName]) or [forms]![frm_Main]![fName]=0 فإننا نختصر هذين الشرطين بشرط واحد len([forms]![frm_Main]![fName] & '')=0 iif(كان الحقل فارغ في النموذج,[fName] اعطنا جميع بيانات الحقل,[forms]![frm_Main]![fName]واذا كان الحقل به قيمة فاستعمل هذه القيمة) . 3. اذا اردنا البحث عن جزء من الاسم Like IIf(Len([forms]![frm_Main]![fName] & '')=0,"*","*" & [forms]![frm_Main]![fName] & "*") والشرح IIf(Len([forms]![frm_Main]![fName] & '')=0 نعم Like "*" لا Like "*" & [forms]![frm_Main]![fName] & "*") . 4. اذا اردنا البحث بين تاريخين بدون سجلات التاريخ الفارغة Between (IIf(Len([Forms]![frm_main]![Date_From] & '')=0,#01-Jan-1900#,[Forms]![frm_main]![Date_From])) And (IIf(Len([Forms]![frm_main]![Date_To] & '')=0,#01-Jan-2900#,[Forms]![frm_main]![Date_To])) والشرح Between (IIf(Len([Forms]![frm_main]![Date_From] & '')=0,#01-Jan-1900#,[Forms]![frm_main]![Date_From])) And (IIf(Len([Forms]![frm_main]![Date_To] & '')=0,#01-Jan-2900#,[Forms]![frm_main]![Date_To])) مع سجلات التاريخ الفارغة Between (IIf(Len([Forms]![frm_main]![Date_From] & '')=0,#01-Jan-1900#,[Forms]![frm_main]![Date_From])) And (IIf(Len([Forms]![frm_main]![Date_To] & '')=0,#01-Jan-2900#,[Forms]![frm_main]![Date_To])) Or [DateX] Is Null والشرح Between (IIf(Len([Forms]![frm_main]![Date_From] & '')=0,#01-Jan-1900#,[Forms]![frm_main]![Date_From])) And (IIf(Len([Forms]![frm_main]![Date_To] & '')=0,#01-Jan-2900#,[Forms]![frm_main]![Date_To])) Or [DateX] Is Null او طريقة استاذنا واخونا العود ابو خليل Between nz([forms]![frm_main]![Date_From];"01/01/1900") And nz([forms]![frm_main]![Date_To];"01/01/2100") . جعفر

سؤال صعب علي ولكن متأكد انه ليس صعب علي الاساتذه مرفق ملف WHAT IF.xlsx

الاخوه الكرام السلام عليكم و رحمه الله الرجاء منكم المساعده فى الملف المرفق انا بشتغل مع مجموعه من الملفات و الرسومات و المراسلات الموجوده فى فولدر رئيسى و متفرع تحت منه مجموعه من الفولدرات مصنفه حسب نوع لمستند و محتاج انى اعمل كود بحث و كوبى حسب اسم الملف او الفولدر فى ملف الكسل المرفق العمود A مجموعه اسماء لملفات مختلفه الامتدادات ( وورد , اكسل و هكذا ) و الملفات دى موجوده تحت عدد من الفولدرات الفرعيه subfolder و كنت محتاج مساعده فى عمل فيجوال بيسك كود عشان اقدر عمل : 1 – محتاج ان الاكسل يبحث عن اسم الملف الموجود فى العمود A فى المسار المحدد فى الخليه C1 و بعيدن يعمل نسخه من الملف ده فى المسار المحدد فى الخليه C4 2 - محتاج ان الاكسل يبحث عن اسم الفولدر الموجود فى العمود A فى المسار المحدد فى الخليه C1 و بعيدن يعمل نسخه من الفولدر ده و جميع الملفات الموجوده فيه فى المسار المحدد فى الخليه C4 . اتمنى ان السؤال يكون واضح لحضراتكم و انا بصراحه محتاج خالص الكود ده للشغل هنا و دورت كتير على النت و لقيت كود ممكن يعمل كوبى للملفات بشرط انها كلها تكون فى فولدر واحد و ده مستحيل انى اعمل ده فى الشغل هنا عشان كميه الملفات اللى المفروض اجمعها تقريبا مائه الف ملف / فولدر جزاكم الله خير مقدما VBA.rar

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

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