اذهب الي المحتوي
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
Custom Search

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


إذهب إلى أفضل إجابة Solved by Foksh,

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

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

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

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

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

مرفق

tesst.accdb

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

  • أفضل إجابة

أخي @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

تم تعديل بواسطه Foksh
  • Thanks 1
رابط هذا التعليق
شارك

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

تم تعديل بواسطه Bshar
  • Thanks 1
رابط هذا التعليق
شارك

@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

 

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

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

من فضلك سجل دخول لتتمكن من التعليق

ستتمكن من اضافه تعليقات بعد التسجيل



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

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

Important Information