فرم جستجوی پیشرفته (چند شرط،بر اساس همه/هریک از کلمات یا عبارات، انتخاب چند شرط برای یک فیلد و ...)

[mazoolagh]

فرض کنید بر مبنای دیتابیس که در پست زیر آمده:
طراحی کارنامه ماهیانه (barnamenevis.org) (https://barnamenevis.org/showthread.php?556411)

قرار هست یک فرم جستجو روی کوئری زیر بسازین:

SELECT S.FullName AS Student, CT.CourseTitle AS Course, C.Year, C.Term, I.FullName AS Instructor, G.Final
FROM
(((Courses AS C INNER JOIN CourseTitles AS CT ON C.CourseTitleID = CT.CourseTitleID)
INNER JOIN Gradings AS G ON C.CourseID = G.CourseID)
INNER JOIN Instructors AS I ON C.InstructorID = I.InstructorID)
INNER JOIN Students AS S ON G.StudentID = S.StudentID;

152738

[mazoolagh]

جستجو میتواند روی دست کم یکی از شروط تعریف شده فیلدهای زیر باشد:

1- Student.FullName : نام دانشجو (تکسباکس - متن دلخواه)

عبارت : یک عبارت (یک یا چند بخشی) در هر جای فیلد
هر بخش : هر یک از بخشها در نام باشد (OR)
همه بخش ها : همه بخشهای مشخص شده باید در نام باشند (AND)
هر کلمه : هر یک کلمات در نام باشد (OR)
همه کلمات : همه کلمات باید در نام باشند (AND)

فواصل اضافی بین بخشها یا در ایتدا و انتهای متن تکسباکس در جستجو منظور نمیشود.

2- Courses.Year : سال تحصیلی (کمبوباکس، شامل سالهایی که در کوئری خام هست + یک انتخاب اضافی به معنای هر سال دلخواه=در جستجو منظر نشود)

3- Courses.Term : ترم تحصیلی (مشابه سال تحصیلی)

4- CourseTitles.CourseTitleID : کد درس (کمبو چند مقداره - با امکان انتخاب هر حالت ممکن از دروس که بطور منطقی فقط میتوانند با هم OR شوند)

[mazoolagh]

1- برای انتخاب نوع جستجو در فیلد Students.FullName از یک Option Group بهره میگیریم.
152745

2- برای ساخت کمبوهای سال و ترم تحصیلی، بترتیب از کوئری های زیر برای RowSource آنها استفاده میکنیم:
SELECT Year FROM Courses GROUP BY Year ORDER BY Year UNION SELECT "----" FROM Courses
SELECT Term FROM Courses GROUP BY Term ORDER BY Term UNION SELECT "----" FROM Courses

3- فرم های جستجو بطور متعارف unbound هستند ولی اینجا چون برای فیلد دوره درسی نیاز به کمبو چند مقداره داریم آن رابه یک جدول bound میکنیم:
152746
دیتا این جدول برای ما اهمیتی ندارد ولی به آن نیاز داریم!

[mazoolagh]

1- برای کمبوهای سال و ترم، تمهیدات لازم را برای اطمینان از صحت مقدار را در نظر میگیریم:

limit to list=true
هندل کردن رخداد on not in list


2- برای سادگی نتایج را در یک لیست باکس (Results) نمایش میدهیم - به سادگی میتوان از یک سابفرم یا ساب ریپورت استفاده کرد.

3- برای نمایش پیام یا وضعیت، بجای msgbox های آزاردهنده، از یک label استفاده میکنیم (Status_lbl)

4- برای ریست کردن فرم و همچنین نمایش همه رکوردها (بدون شرط) ، comman button های لازم را به فرم اضافه میکنیم.

5- با استفاده از regular expressions فواصل اضافی بین بخش های متن مورد جستجو را حذف میکنیم.

6- از dictionary برای نگهداری شرط ها استفاده و itemهای آن را Join میکنیم (با توجه به شرط مشخص شده در option group)

7- در رخداد from open ، آرایه ها و متغیرهای پابلیک رو آماده میکنیم.

[mazoolagh]

152748
152749
152750

[mazoolagh]

Option Compare Database
Option Explicit
Dim whr As Dictionary
Dim sql, cp, cw As String
Dim wrd


Private Sub Courses_AfterUpdate()
Me.Requery
End Sub


Private Sub Form_Open(Cancel As Integer)
Reset_btn_Click
sql = Replace(CurrentDb.QueryDefs("Results_RAW").sql, ";", "")
Set whr = New Dictionary
wrd = Array("'@txt *'", "'* @txt *'", "'* @txt'", "'@txt'")
cp = Part_Criteria("S.FullName")
cw = Word_Criteria("S.FullName")
End Sub
Private Sub Reset_btn_Click()
Me.Student_tb = ""
Me.Years_cb = Me.Years_cb.ItemData(0)
Me.Terms_cb = Me.Terms_cb.ItemData(0)
DoCmd.RunSQL ("DELETE Search.Courses.value FROM Search")
Me.Courses.Requery
Me.Results.Visible = False
Me.Results.RowSource = ""
Me.Status_lbl.Caption = ""
End Sub
Function Part_Criteria(FieldName As String) As String
Part_Criteria = FieldName & " Like '*@txt*'"
End Function
Function Word_Criteria(FieldName As String) As String
Dim tmp(3) As String
Dim i As Integer
For i = 0 To 3
tmp(i) = FieldName & " Like " & wrd(i)
Next i
Word_Criteria = "(" & Join(tmp, " OR ") & ")"
End Function
Private Sub Search_btn_Click()
Me.Status_lbl.Caption = ""
whr.RemoveAll
Dim txt As String
Dim i As Integer
Dim D As New Dictionary


txt = Me.Student_tb
If txt = "" Then GoTo Next_Step
Dim Texts
Texts = Split(txt)
If Me.Student_Search_Type_og = 1 Then ' entire phrase anywhere
whr.Add whr.Count + 1, Replace(cp, "@txt", txt)
Else
For i = 0 To UBound(Texts)
If Len(Texts(i)) > 1 Then
Select Case Me.Student_Search_Type_og
Case 2, 3 ' any part / all parts
D.Add D.Count + 1, Replace(cp, "@txt", Texts(i))
Case 4, 5 ' any word / all words
D.Add D.Count + 1, Replace(cw, "@txt", Texts(i))
End Select
End If
Next
Select Case Me.Student_Search_Type_og
Case 2, 4 ' any part / any word
whr.Add whr.Count + 1, "(" & Join(D.Items, " OR ") & ")"
Case 3, 5 ' all parts / all words
whr.Add whr.Count + 1, "(" & Join(D.Items, " AND ") & ")"
End Select
End If


Next_Step:
If Val(Me.Years_cb) > 0 Then
whr.Add whr.Count + 1, "C.Year=" & Me.Years_cb
End If


If Val(Me.Terms_cb) > 0 Then
whr.Add whr.Count + 1, "C.Term=" & Me.Terms_cb
End If


If Not IsNull(Me.Courses.Value) Then
whr.Add whr.Count + 1, "C.CourseTitleID IN (" & Join(Me.Courses.Value, ",") & ")"
End If


If whr.Count = 0 Then
Me.Status_lbl.Caption = "Atleast 1 criteria should be specified!"
Else
Bind (sql + " WHERE " + Join(whr.Items, " AND "))
End If
End Sub
Private Sub Bind(RowSource As String)
Me.Results.RowSource = RowSource
Dim n As Integer
n = Me.Results.ListCount
Me.Status_lbl.Caption = IIf(n = 0, 0, n - 1) & " records found"
Me.Results.Visible = n > 0
End Sub
Private Sub ShowAll_btn_Click()
Reset_btn_Click
Bind (sql)
End Sub


Private Sub Student_tb_AfterUpdate()
Dim txt As String
txt = Trim(Nz(Me.Student_tb.Text, ""))
Dim regexp As New regexp
regexp.Global = True
regexp.Pattern = "\s+"
Me.Student_tb = regexp.Replace(txt, " ")
End Sub


Private Sub Terms_cb_AfterUpdate()
If Nz(Me.Terms_cb, "") = "" Then
Me.Terms_cb = Me.Terms_cb.ItemData(0)
End If
End Sub


Private Sub Terms_cb_NotInList(NewData As String, Response As Integer)
Me.Terms_cb = Me.Terms_cb.ItemData(0)
Response = acDataErrContinue
End Sub


Private Sub Years_cb_AfterUpdate()
If Nz(Me.Years_cb, "") = "" Then
Me.Years_cb = Me.Years_cb.ItemData(0)
End If
End Sub


Private Sub Years_cb_NotInList(NewData As String, Response As Integer)
Me.Years_cb = Me.Years_cb.ItemData(0)
Response = acDataErrContinue
End Sub

[mazoolagh]

برنامه نمونه:

[moustafa]

با سلام و تشکر
کمبوباکس مولتی ولویو یا مولتی سلکت بدون جدول چطور ساخته میشه ؟

[mazoolagh]

با سلام و تشکر
کمبوباکس مولتی ولویو یا مولتی سلکت بدون جدول چطور ساخته میشه ؟

سلام دوباره
احتمالا منظور شما از "بدون جدول" همون unbound هست،
که نمیشه!
این حالت mltivalue بودن در فرم مشخص نمیشه و به تعریف underlying data جدول برمیگرده.

[moustafa]

سلام دوباره
احتمالا منظور شما از "بدون جدول" همون unbound هست،
که نمیشه!
این حالت mltivalue بودن در فرم مشخص نمیشه و به تعریف underlying data جدول برمیگرده.

منظورم اینه که به کنترل سورسی که متصله مولتی ولیو نیست در واقع در تیبلش به مولتی ولیو تنظیم نشده اینی که شما گذاشتی چطوریه؟ من تنظیمات خاص یا کد ندیدم برای مولتی ویو اگه ممکنه این رو تشریح بفرمایین . با تشکر

[mazoolagh]

منظورم اینه که به کنترل سورسی که متصله مولتی ولیو نیست در واقع در تیبلش به مولتی ولیو تنظیم نشده اینی که شما گذاشتی چطوریه؟ من تنظیمات خاص یا کد ندیدم برای مولتی ویو اگه ممکنه این رو تشریح بفرمایین . با تشکر

اگر دقت کنین record source فرم جستجوی ما (search) جدول search هست (فرم bound داریم)،
و این جدول فقط یک فیلد courses از نوع multi-value داره که row source اون جدول course titles هست.

[moustafa]

اگر دقت کنین record source فرم جستجوی ما (search) جدول search هست (فرم bound داریم)،
و این جدول فقط یک فیلد courses از نوع multi-value داره که row source اون جدول course titles هست.

شرمنده با ذهنیت فرم گزارشگیری که معمولا bound نمیشه record source اون نگاه نکردم . چون همچین موردی رو برای گزارشگیری میخواستم

[mazoolagh]

با ذهنیت فرم گزارشگیری که معمولا bound نمیشه record source اون نگاه نکردم . چون همچین موردی رو برای گزارشگیری میخواستم
فرقی نمیکنه که دیتاست رو برای چه کاری نیاز دارین (فرم، ریپورت، ...)،
شما همین روش رو برای ریپورت هم میتونین استفاده کنین:
مشکل در اجرای کوئری با چندین شرط (https://barnamenevis.org/showthread.php?544014)