اذهب الي المحتوي
أوفيسنا

تعديل كود بحث متعدد


الردود الموصى بها

السلام عليم

 

في الكود التالي  الذي يبحث في عدة حقوول

المطلوب استبدال الخيار الخاص بالبحث  بواسطة   end with

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

اي تصبح الخيارات

 

يبداء ب 

يتضمن

يطابق

 

وشكرا لكم مقدما

Private Sub searchbox_AfterUpdate()
Dim asem As String
Select Case searchtype
Case 1
asem = "Like '" & searchbox & "*'"
Case 2
asem = "Like '*" & searchbox & "*'"
Case 3
asem = "Like '*" & searchbox & "'"
End Select
If Check165 = True And Check171 = True Then
Me.Filter = "[elem_name] " & asem & " or [acpt1]" & asem & " or [acpt2]" & asem & "or [acpt3]" & asem & " or [acpt4]" & asem & " or [acpt5]" & asem & "or [acpt6]" & asem & "or [acpt7]" & asem & "or [acpt8]" & asem & "or [acpt9]" & asem & "or [acpt10]" & asem & "or [acpt11]" & asem & "or [acpt12]" & asem & "or [acpt13]" & asem & "or [acpt14]" & asem & "or [acpt15]" & asem & "or [acpt16]" & asem & " or [acpt18]" & asem & " or [cas]" & asem & "or [cab20]" & asem & "or [elem_Stract]" & asem
Me.FilterOn = True
DoCmd.GoToControl "searchbox"
If Me.RecordsetClone.RecordCount = 0 Then
MsgBox "NO Record ."
Me.Filter = ""
Me.FilterOn = False
Else
Me.RecordsetClone.MoveLast
End If

ElseIf Check165 = False And Check171 = True Then
Me.FilterOn = True
DoCmd.GoToControl "searchbox"
If Me.RecordsetClone.RecordCount = 0 Then
MsgBox "NO Record ."
Me.Filter = ""
Me.FilterOn = False
Else
Me.RecordsetClone.MoveLast
End If

ElseIf Check165 = True And Check171 = False Then
Me.Filter = "[elem_name] " & asem & " or [acpt1]" & asem & " or [acpt2]" & asem & "or [acpt3]" & asem & "or [acpt4]" & asem & "or [acpt5]" & asem & "or [acpt6]" & asem & "or [acpt7]" & asem & "or [acpt8]" & asem & "or [acpt9]" & asem & "or [acpt10]" & asem & "or [acpt11]" & asem & "or [acpt12]" & asem & "or [acpt13]" & asem & "or [acpt14]" & asem & "or [acpt15]" & asem & "or [acpt16]" & asem & " or [acpt18]" & asem & " or [cab20]" & asem & " or [elem_Stract]" & asem
Me.FilterOn = True
DoCmd.GoToControl "searchbox"
If Me.RecordsetClone.RecordCount = 0 Then
MsgBox "NO Record ."
Me.Filter = ""
Me.FilterOn = False
Else
Me.RecordsetClone.MoveLast
End If


ElseIf Check165 = False And Check171 = False Then
Me.Filter = "[elem_name] " & asem & " or [acpt1]" & asem & " or [acpt2]" & asem & "or [acpt3]" & asem & "or [acpt4]" & asem & "or [acpt5]" & asem & "or [cab20]" & asem & "or [acpt6]" & asem & "or [acpt7]" & asem & "or [acpt8]" & asem & "or [acpt9]" & asem & "or [acpt10]" & asem & "or [acpt11]" & asem & "or [acpt12]" & asem & "or [acpt13]" & asem & "or [acpt14]" & asem & "or [acpt15]" & asem & "or [acpt16]" & asem & "or [cab20]" & asem & " or [acpt18]" & asem & ""
Me.FilterOn = True
DoCmd.GoToControl "searchbox"
If Me.RecordsetClone.RecordCount = 0 Then
MsgBox "NO Record ."
Me.Filter = ""
Me.FilterOn = False
Else
Me.RecordsetClone.MoveLast
End If



End If
Me.searchbox = Null
Me.Bah = Null

End Sub

رابط هذا التعليق
شارك

  • 2 weeks later...

 

السلام عليم

 

في الكود التالي  الذي يبحث في عدة حقوول

المطلوب استبدال الخيار الخاص بالبحث  بواسطة   end with

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

اي تصبح الخيارات

 

يبداء ب 

يتضمن

يطابق

 

وشكرا لكم مقدما

Private Sub searchbox_AfterUpdate()
Dim asem As String
Select Case searchtype
Case 1
asem = "Like '" & searchbox & "*'"
Case 2
asem = "Like '*" & searchbox & "*'"
Case 3
asem = "Like '*" & searchbox & "'"
End Select
If Check165 = True And Check171 = True Then
Me.Filter = "[elem_name] " & asem & " or [acpt1]" & asem & " or [acpt2]" & asem & "or [acpt3]" & asem & " or [acpt4]" & asem & " or [acpt5]" & asem & "or [acpt6]" & asem & "or [acpt7]" & asem & "or [acpt8]" & asem & "or [acpt9]" & asem & "or [acpt10]" & asem & "or [acpt11]" & asem & "or [acpt12]" & asem & "or [acpt13]" & asem & "or [acpt14]" & asem & "or [acpt15]" & asem & "or [acpt16]" & asem & " or [acpt18]" & asem & " or [cas]" & asem & "or [cab20]" & asem & "or [elem_Stract]" & asem
Me.FilterOn = True
DoCmd.GoToControl "searchbox"
If Me.RecordsetClone.RecordCount = 0 Then
MsgBox "NO Record ."
Me.Filter = ""
Me.FilterOn = False
Else
Me.RecordsetClone.MoveLast
End If

ElseIf Check165 = False And Check171 = True Then
Me.FilterOn = True
DoCmd.GoToControl "searchbox"
If Me.RecordsetClone.RecordCount = 0 Then
MsgBox "NO Record ."
Me.Filter = ""
Me.FilterOn = False
Else
Me.RecordsetClone.MoveLast
End If

ElseIf Check165 = True And Check171 = False Then
Me.Filter = "[elem_name] " & asem & " or [acpt1]" & asem & " or [acpt2]" & asem & "or [acpt3]" & asem & "or [acpt4]" & asem & "or [acpt5]" & asem & "or [acpt6]" & asem & "or [acpt7]" & asem & "or [acpt8]" & asem & "or [acpt9]" & asem & "or [acpt10]" & asem & "or [acpt11]" & asem & "or [acpt12]" & asem & "or [acpt13]" & asem & "or [acpt14]" & asem & "or [acpt15]" & asem & "or [acpt16]" & asem & " or [acpt18]" & asem & " or [cab20]" & asem & " or [elem_Stract]" & asem
Me.FilterOn = True
DoCmd.GoToControl "searchbox"
If Me.RecordsetClone.RecordCount = 0 Then
MsgBox "NO Record ."
Me.Filter = ""
Me.FilterOn = False
Else
Me.RecordsetClone.MoveLast
End If


ElseIf Check165 = False And Check171 = False Then
Me.Filter = "[elem_name] " & asem & " or [acpt1]" & asem & " or [acpt2]" & asem & "or [acpt3]" & asem & "or [acpt4]" & asem & "or [acpt5]" & asem & "or [cab20]" & asem & "or [acpt6]" & asem & "or [acpt7]" & asem & "or [acpt8]" & asem & "or [acpt9]" & asem & "or [acpt10]" & asem & "or [acpt11]" & asem & "or [acpt12]" & asem & "or [acpt13]" & asem & "or [acpt14]" & asem & "or [acpt15]" & asem & "or [acpt16]" & asem & "or [cab20]" & asem & " or [acpt18]" & asem & ""
Me.FilterOn = True
DoCmd.GoToControl "searchbox"
If Me.RecordsetClone.RecordCount = 0 Then
MsgBox "NO Record ."
Me.Filter = ""
Me.FilterOn = False
Else
Me.RecordsetClone.MoveLast
End If



End If
Me.searchbox = Null
Me.Bah = Null

End Sub

السلام عليكم ورحمة الله تعالى وبركاته

اتفضل ده مثال اعتقد زى ما حضرتك طلبت تقريبا او حاجه قريبه قوى من طلب حضرتك 

http://www.officena.net/ib/index.php?app=core&module=attach&section=attach&attach_id=88523

post-129737-0-10261600-1423242897.png

رابط الموضوع 

http://www.officena.net/ib/index.php?showtopic=58852

رابط هذا التعليق
شارك

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information