مساعده في فلتره بأكثر من اختيار

[Bshar]

السلام عليكم ورحمة الله,,

تحيه طيبه الى اخواني الكرام

كيف لي ان افلتر باختيار اكثر من اختيارين في الكمبوبكس او قائمة اختيارات  مثلا اعمل فلتره على سجلات التي يحتوي حقل اللون فيها  على  (ابيض واسود / ابيض واخضر) بنفس الوقت .

 وجزاكم الله خير

مرفق

tesst.accdb

[Foksh]

جاري العمل ، تقريباً توصلت لطريقة آمنة 😁

[Bshar]

@Fokshاستاذ فادي انت مافي شي بيصعب عليك 😄

[Foksh]

أخي @Bshar جزاك الله خيراً على هذه الثقة 🥰 .

 

اتمنى أن أكون قد وصلت الى حل مناسب ، انظر ماذا فعلت للوصول لطلبك :-

1. قمت بالتعديل على الاستعلام والذي هو مصدر سجلات للنموذج الفرعي ليصبح فقط لفلترة الاسم . بهذا الشكل SQL :-

SELECT doc.name, tape.ID, tape.[code-work], tape.[t-namber], tape.type, tape.lincec, tape.color
FROM doc INNER JOIN tape ON doc.ID = tape.[code-work]
WHERE (((doc.name) Like "*" & [Forms]![add-tab]![xxf] & "*"));

2. انشأت مربع نص وأسميته Foksh 😁 ، وجعلت قيمته :-

Me.Foksh = Foksh & "," & Me.xxc
' هو كومبوبوكس الألوان XXC حيث

3. انشأت دالة لتطبيق الفلترة :-

Private Sub ApplyFilter()
    Dim filterCriteria As String
    Dim selectedValues() As String
    Dim i As Integer
    selectedValues = Split(Me.Foksh, ",")
    For i = LBound(selectedValues) To UBound(selectedValues)
        If selectedValues(i) <> "" Then
            filterCriteria = filterCriteria & "[tape].[color] = '" & Trim(selectedValues(i)) & "' OR "
        End If
    Next i
    If filterCriteria <> "" Then
        filterCriteria = Left(filterCriteria, Len(filterCriteria) - 4)
    End If
    Me.tape5.Form.Filter = filterCriteria
    Me.tape5.Form.FilterOn = True
End Sub

4. في حدث بعد التحديث للكومبوبوكس XXC سيتم نقل القيم الى مربع النص Foksh والفصل بين القيم عند تغييرها بالفاصلة ","  :-

    Me.Foksh = Foksh & "," & Me.xxc
    ApplyFilter
    Me.tape5.Requery

 

وفي النهاية هذا هو الناتج  tesst.accdb

تم تعديل April 21 بواسطه Foksh

[Bshar]

@Foksh اخي واستاذي الفاضل فادي , اشكرك على مجهودك الرائع والمميز , وكما عرفناك لايوجد شيء صعب عندك ,, بارك الله بك وبارك الله في رزقك وزادك علما. 🌹

تم تعديل April 21 بواسطه Bshar

[Bshar]

@Foksh  حاولت ان اعمل تقرير على ما تم الفلتره عليه من لونين ولم انجح بسبب ان معيار الاستعلام يفلتر على لون واحد فقط وعند اختيار اكثر من ذلك لا يعمل الاستعلام ,,

كيف لي ان اعمل تقرير على ماتم الفلتره عليه اذا اخترت  اكثر من لون 😬

[Foksh]

14 ساعات مضت, Bshar said:

@Foksh  حاولت ان اعمل تقرير على ما تم الفلتره عليه من لونين ولم انجح بسبب ان معيار الاستعلام يفلتر على لون واحد فقط وعند اختيار اكثر من ذلك لا يعمل الاستعلام ,,

كيف لي ان اعمل تقرير على ماتم الفلتره عليه اذا اخترت  اكثر من لون 😬

تفضل أخي @Bshar ، تم الإستعانة بنموذج مؤقت Temp ، لإدراج قيم الفلترة فيه ومن ثم انشاء تقرير مبني على هذا الجدول . وهذا الكود ليقوم بتنفيذ المهمة :-

Private Sub Rep_Btn_Click()
    ApplyFilter
    DoCmd.SetWarnings False
    DoCmd.RunSQL "DELETE FROM Temp"
    DoCmd.SetWarnings True
    Dim rs As DAO.Recordset
    Set rs = Me.tape5.Form.RecordsetClone
If IsNull(Foksh) Then
    DoCmd.CancelEvent
    Exit Sub
Else
    rs.MoveFirst
    Do Until rs.EOF
        Dim selectedValues() As String
        selectedValues = Split(Me.Foksh, ",")
        
        Dim i As Integer
        For i = LBound(selectedValues) To UBound(selectedValues)
            If InStr(1, rs!color, Trim(selectedValues(i)), vbTextCompare) > 0 Then
                CurrentDb.Execute "INSERT INTO Temp (ID, namee, [code-work], [t-namber], type, lincec, color) " & _
                                  "VALUES (" & rs!ID & ", '" & Forms![add-tab]![xxf] & "', " & rs![code-work] & ", '" & rs![t-namber] & "', " & _
                                  "'" & rs![type] & "', '" & rs![lincec] & "', '" & rs![color] & "')"
                Exit For
            End If
        Next i
        rs.MoveNext
    Loop
    rs.Close
    Set rs = Nothing
    DoCmd.OpenReport "Table1", acViewPreview
End If
End Sub

Foksh.accdb

 

وأعتذر عن التأخير بسبب ظرف صحي .

[Bshar]

اشكرك فووكش والحمدالله على سلامتك 🌹🌹

[Eng.Qassim]

8 ساعات مضت, Foksh said:

أعتذر عن التأخير بسبب ظرف صحي

ماعندك الا العافية استاذ فادي 

[Foksh]

49 دقائق مضت, Eng.Qassim said:

ماعندك الا العافية استاذ فادي 

سلمك الله مهندس قاسم 🥰