FILTER ไม่เนียน
กระทู้เก่าบอร์ด อ.Yeadram

 1,479   3
URL.หัวข้อ / URL
FILTER ไม่เนียน

Sub SERCH1()
Dim a As String
If IsNull(Text18) Then
Text18 = ""
End If

a = Text18
Text18 = "name LIKE" & " " & "'" & "*" & Text18 & "*" & "'"
On Error Resume Next
If Text18 <> "" Then
Me.Filter = Text18
Me.FilterOn = True
Text18 = a

Dim rst As DAO.Recordset
Set rst = Me.RecordsetClone
    rst.MoveLast
If rst.RecordCount = 0 Then
Me.FilterOn = False
MsgBox ("ไม่พบเงื่อนไข" & " " & Text18)
Text18 = ""
Text18.SetFocus
     rst.Close
        Set rst = Nothing
Exit Sub
End If
Else:
MsgBox ("ดูทั้งหมด")
Me.Filter = ""
Me.Requery
Text18 = ""

End If
End Sub

ปัญหาคือ หลังจาก FILTER พบแล้ว   FILTER เงื่อนไขใหม่
เช่น ได้    DIE ต่อไปจะหา XIR ผมจะต้องลบ DIE ออกก่อน แต่มันกดแป้น
DELETE ไม่ได้ (ซึ่งผมไม่เข้าใจ แต่ถ้าพิมพ์ XIR ข้างหน้าแล้วทยอยลบ DIE ออกทำได้)
หรือไม่ก็ ต้องให้ MOUSE ลากดำ แล้วพิมพ์ทับเลยก็ทำได้
ผมอยากให้มัน ระบายทึบดำ DIE ไว้เลยได้ไหมครับหลังจาก SET FOCUS แล้ว
คือกะพิมพ์ทับเลย แต่ปัจจุบันมันเป็น CURSOR กระพิบ อยู่ที่ตัวหน้า D(DIE)

CODE ที่เขียนมั่วๆ หน่อยนะครับ เพราะจับผสมกัน จะแนะนำอะไรเพิ่มเติมก็ยินดีครับ

3 Reply in this Topic. Dispaly 1 pages and you are on page number 1

1 @R00231
Sub SERCH1()
Dim a As String
If not (IsNull(Text18)) or text18<>"" Then
a = ([name] LIKE '*" & text18 & "*')"
me.filter=a
me.filteron=true


Dim rst As DAO.Recordset
Set rst = Me.RecordsetClone
    rst.MoveLast
If rst.RecordCount = 0 Then
rst.Close
Set rst = Nothing
me.filteron=false
if (MsgBox ("ไม่พบเงื่อนไขตามที่ระบุ" & vbcrlf & chr(34) & Text18) & chr(34) & vbcrlf & "ต้องการกรองใหม่หรือไม่?") =vbyes then goto newfilt
else
if (msgbox ("ดูทั้งหมด?")=vbyes then goto newfilt    
end if
        exit sub
newfilt:
Text18.SetFocus
text18.sellength=len(text18)
End Sub
2 @R00233
แฮะๆ ทำแล้วไม่ได้ เดี๋ยวผมไปอ่านเพิ่มเติมก่อน
ว่าบรรทัด
if (MsgBox ("ไม่พบเงื่อนไขตามที่ระบุ" & vbcrlf & chr(34) & Text18) & chr(34) & vbcrlf & "ต้องการกรองใหม่หรือไม่?") =vbyes then goto newfilt
แปลว่าอะไร
แต่ เรื่อง CODE
ผมแก้ปัญหาง่ายๆด้วยการ เขียนเพิ่ม อย่างนี้ครับ
ก็พอ ถูไถไปได้ ครับ ขอบคุณครับ

Private Sub Text18_KeyDown(KeyCode As Integer, Shift As Integer)
If Text18 <> "" Then
Text18 = ""
End If
End Sub
3 @R00244
ขออภัยครับ ในบรรทัดนี้ หลัง text18 มีวงเล็บเกินมาตัวหนึ่ง
แล้วอาจต้องปรับเพิ่มอีกนิดหน่อยตรง ปุ่มที่ให้เลือก

if (MsgBox ("ไม่พบเงื่อนไขตามที่ระบุ" & vbcrlf & chr(34) & Text18 & chr(34) & vbcrlf & "ต้องการกรองใหม่หรือไม่?", vbYesNo) =vbyes then goto newfilt

มันหมายความว่าเมื่อทำงานมาถึงบรรทัดนี้ ให้ขึ้นข้อความ พร้อมมีปุ่มให้กด คือปุ่ม yes กับ no
และถ้าผู้ใช้ ตอบ yes ให้ไปทำงาน ที่ บรรทัด newfilt

---------------------------------
ส่วนอีกอัน ก็ต้องเพิ่มปุ่มตัวเลือกให้เป็นเช่นเดียวกัน
if (msgbox ("ดูทั้งหมด?", vbYesNo)=vbyes then goto newfilt   
@ ประกาศใช้งานเว็บบอร์ดใหม่ => บอร์ดเรียนรู้ Access สำหรับคนไทย
แล้วจะใส่ลิ้งอ้างอิงมาที่โพสต์เก่านี้หรือไม่ก็ตามสะดวกครับ
Time: 0.2592s