กระทู้เก่าบอร์ด อ.Yeadram
1,560 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 ที่เขียนมั่วๆ หน่อยนะครับ เพราะจับผสมกัน จะแนะนำอะไรเพิ่มเติมก็ยินดีครับ
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
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
ว่าบรรทัด
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
แล้วอาจต้องปรับเพิ่มอีกนิดหน่อยตรง ปุ่มที่ให้เลือก
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
Time: 0.3688s
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