تعديل المرفق ليتم البحث في جميع حقول النموذج الفرعي

[husamwahab]

السلام عليكم استاذ محمد القدسي

محاولة عسى ان تكون موفقة

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

Private Sub txtSearchText_Change()
  Const acEnd = 3
  Dim Rst As Recordset
  Dim SearchText As String
  Dim FieldName As String
  Dim Cntl As Control
  Dim strFilter  As String
  Dim i As Long
  
  Me.txtSearchText.SetFocus
  SearchText = Nz(Me.txtSearchText.Text, "")
  
  If SearchText <> "" Then
    Select Case Me.CmbMatch
      Case acAnywhere: SearchText = "*" & SearchText & "*"
      Case acEntire:   SearchText = SearchText
      Case acStart:    SearchText = SearchText & "*"
      Case acEnd:      SearchText = "*" & SearchText
    End Select
  End If
  
  If Me.OptSearch = 1 Then
    Me.txtRecords.Visible = True
    Me.RecRecords.Visible = True
  Else
    Me.txtRecords.Visible = False
    Me.RecRecords.Visible = False
  End If
     '---------------------------------------------------
       Set Rst = Me.Controls(Me.CmbSubforms).Form.RecordsetClone
       strFilter = ""
       For i = 2 To (Me.CmbFields.ListCount - 1)
         Set Cntl = Me.Controls(Me.CmbSubforms).Form.Controls(Me.CmbFields.ItemData(i))
         FieldName = "[" & Cntl.ControlSource & "]"
         strFilter = strFilter & " or " & FieldName & " Like '" & SearchText & "'"
       Next i
         Set Cntl = Me.Controls(Me.CmbSubforms).Form.Controls(Me.CmbFields.ItemData(1))
          FieldName = "[" & Cntl.ControlSource & "]"
          Rst.Filter = FieldName & " Like '" & SearchText & "'" & strFilter
          Set Rst = Rst.OpenRecordset
        With Rst
          If .RecordCount > 0 Then .MoveLast
          Me.txtRecords = .RecordCount
        End With
        Rst.Close
  
  Select Case Me.OptSearch
    Case 1
      '---------------------------------------------
      For i = 1 To (Me.CmbFields.ListCount - 1)
        Set Cntl = Me.Controls(Me.CmbSubforms).Form.Controls(Me.CmbFields.ItemData(i))
        FieldName = "[" & Cntl.ControlSource & "]"
        Cntl.FormatConditions.Delete
      '-----------------------------------------------
        Me.Controls(Me.CmbSubforms).Form.FilterOn = False
        With Me.Controls(Me.CmbSubforms).Form.RecordsetClone
          .FindFirst FieldName & " Like '" & SearchText & "'"
          If Not .NoMatch Then
            Me.Controls(Me.CmbSubforms).Form.Bookmark = .Bookmark
            With Cntl
              If .Section = 0 Then
                .FormatConditions.Add acExpression, , .Name & " Like '" & SearchText & "'"
                .FormatConditions(0).BackColor = 8454143
                .FormatConditions(0).ForeColor = vbBlue
               '.FormatConditions(0).FontBold = True
              End If
            End With
          End If
        End With
      Next i
    Case 2
      strFilter = ""
      For i = 1 To (Me.CmbFields.ListCount - 1)
        Set Cntl = Me.Controls(Me.CmbSubforms).Form.Controls(Me.CmbFields.ItemData(i))
        FieldName = "[" & Cntl.ControlSource & "]"
        Cntl.FormatConditions.Delete
      Next i
      For i = 2 To (Me.CmbFields.ListCount - 1)
        Set Cntl = Me.Controls(Me.CmbSubforms).Form.Controls(Me.CmbFields.ItemData(i))
        FieldName = "[" & Cntl.ControlSource & "]"
        strFilter = strFilter & " or " & FieldName & " Like '" & SearchText & "'"
      Next i
      With Me.Controls(Me.CmbSubforms).Form
        Set Cntl = Me.Controls(Me.CmbSubforms).Form.Controls(Me.CmbFields.ItemData(1))
        FieldName = "[" & Cntl.ControlSource & "]"
        If SearchText <> "" Then
          .Filter = FieldName & " Like '" & SearchText & "'" & strFilter
          .FilterOn = True
        Else
          .FilterOn = False
        End If
      End With
  End Select
  LastSearchText = Nz(Me.txtSearchText.Text, "")
End Sub

 

[محمد القدسي]

نفس الخطأ استاذي 

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

[husamwahab]

هل ممكن ارسال نفس الملف الذي يظهر الخطا فيه

57 minutes ago, محمد القدسي said:

كذلك تحديد البحث ضمن الحقل عندي ما يظهر

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

[محمد القدسي]

هذا هو استاذي

aboosama.rar

[husamwahab]

الملف شغال عندي بصورة جيدة ودون اي مشاكل

جرب ان تغيير نسخة الاوفيس 

[محمد القدسي]

استاذي القدير @husamwahab هذا المرفق شغال عندي تمام 

ولاكن يبحث في حقل الاسماء فقط 

والاوفيس عندي 2010

تظليل وعد كلمات نتائح البحث.rar

[husamwahab]

تفضل التعديل على الملف 

Search&Sort_222.rar

[محمد القدسي]

استاذي الخطا يظهر لي عند هذا السطر عند الضغط علي اي مفتاح كيبور

لماذا الله اعلم 

[husamwahab]

المهم في المرفق الاخير ظهرت النماذج الفرعية والحقول ام لا

[محمد القدسي]

لا ما ظهرت استاذي

[husamwahab]

استاذ محمد القدسي جرب هذه المحاولة وان شاء الله تكون موفقة

SearchSort-5.rar

[محمد القدسي]

هنا الخطأ ظهر استاذي نفس الخطا السابق

[husamwahab]

استاذ محمد القدسي جرب هذا المرفق وان شاء الله لا يوجد خطا

SearchSort-6.rar

[محمد القدسي]

اشكرك استاذي @husamwahab على مجهودك وصبرك 

والله اني كنت استحييت منك من كثر المحاولة وانت صابر

البرنامج شغال فل ولله الحمد والمنه 

ثم لك مني الشكر الجزيل 

ومن باب الشكر على مجهودك 

اسال من الله ان يبارك فيك وفي علمك وان يرزقك الجنة ويباعد وجهك عن النار انت وكل من تعاون معنا في هذا الصرح المبارك

[husamwahab]

On 10/31/2020 at 12:48 AM, محمد القدسي said:

اسال من الله ان يبارك فيك وفي علمك وان يرزقك الجنة ويباعد وجهك عن النار انت وكل من تعاون معنا في هذا الصرح المبارك

اجمعين اللهم امين ورحم الله والديك