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

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


إذهب إلى أفضل إجابة Solved by 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

 

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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