Đánh giá chủ đề:
  • 0 Votes - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
Form lọc dữ liệu
#1
Chào các anh chị, em có tìm được trên mạng 1 file lọc dữ liệu theo nhiều điêu kiện. Về chỉnh sữa lại theo nhu cầu cá nhân.
Nhưng có 1 vấn đề, em chỉnh sữa lại từ dạng Form Continuous Forms sang dạng main form và subform, nhưng khi đưa subform vo mạinform thì subform không hiện thị tất cả cá record, (chỉ hiện thị 1 recorf duy nhât). Nhờ các anh chị giúp đỡ.
https://drive.google.com/file/d/0Bz23-2t...sp=sharing
Chữ ký của huuduy.duy Xin chào, mình là huuduy.duy, Tham gia http://thuthuataccess.com/forum từ ngày 24-06 -13.
ღღღღღTài sản của huuduy.duy (View All Items) ღღღღღ
Reply
Những người đã cảm ơn
#2
- Bạn phải nghiên cứu cơ bản thật kỹ kỹ thuật sử dụng Main - Sub form.
- Chuyển từ Continuous form sang MainF - SubF là thay đổi nhiều lắm đó. Code vba cũng phải thay đổi hoàn toàn nếu có đến tham chiếu các Control giữa MainF và SubF.

Đối với file demo này của bạn: 
- MainF thường sẽ không có Record Source. File của bạn gán Record Source cho MainF và còn link master/child nên MF đang hiển thị record nào thì SF nó cũng chỉ hiện 1 record theo đúng cái Field bạn dùng để link.
- Để lọc SubF thì thường dùng Link Master/Child fields để liên kết giữa MainF và SubF. Lọc bao nhiêu trường thì liệt kê, đưa hết các trường đó vô Link Master/Child (cách nhau dấu phẩy ",")
Trường hợp của demo này bạn thì điều kiện lọc của nó không dùng Link Master/Child được. VD: Lọc theo trường [IsCorporate] thì có 2 trường hợp là "Yes" hoặc "No", nếu thêm trường hợp lọc là "Both" thì Master/Child không làm được.
- Code của nút lệnh "cmdFilter" cũng phải thay đổi. Nó dùng câu lệnh: 
   Me.Filter strWhere  => Nó lọc trên chính Record Source của nó (Me.Filter). Bây giờ bạn lọc trên Record Source của SubF thì phải đổi tham chiếu form lại. Ví dụ: Me.SubF.Form.Filter
Mấy vấn đề chính là vậy, bạn tìm hiểu thêm nữa đi.
Chữ ký của ongke0711 If you BORN poor, it's not your mistake. But if you DIE poor, It's your mistake!
ღღღღღTài sản của ongke0711 (View All Items) ღღღღღ
Reply
Những người đã cảm ơn huuduy.duy , maidinhdan
#3
Chào các anh chị

Em có tham khảo code tìm kiếm nhiều điều kiện trên diễn đàn về chỉnh sữa và áp dụng vô ứng dụng của mình nhưng bị lỗi. zem gởi file lên nhờ các anh chị xem và giúp đỡ.
Mục đích của em là tìm kiếm theo họ và tên, Bộ phận, từ ngày đến ngày, .... 
Rất mong được các anh chị giúp đỡ
Trân trọng cảm ơn

Tải file tại đây


P/s: Em đã làm được 1 ít, riêng phần tìm từ ngày tới ngày không chính xác. Riêng phần tìm theo quý, mong các anh chị giúp đỡ
Chữ ký của huuduy.duy Xin chào, mình là huuduy.duy, Tham gia http://thuthuataccess.com/forum từ ngày 24-06 -13.
ღღღღღTài sản của huuduy.duy (View All Items) ღღღღღ
Reply
Những người đã cảm ơn
#4
Bạn chú ý một số điểm sau:
- Điệu kiện dạng chuỗi (text) thì bạn phải đưa nó vào giữa 2 dấu nháy đơn " ' ".
- Nếu lấy tham số từ Form thì bạn phải thêm dấu  " & " trước nó thì vba mới hiểu.
- Chú ý cách đặt tên cho các control, tên trường cho thống nhất để dễ viết, sửa code. 
  Vd: Combobox -> nên là "cbo" chứ không phải "cbx"
        Table        -> nên là "tbl" chứ không phải "tb". Lúc 3 ký tự lúc 2 ký tự.

Link file: http://www.mediafire.com/download/8ktxfp...imKiem.mdb


Mã PHP:
Sub Loc()
   Dim dieukienloc As StringstrSQL As String
   If IsNull
(Me.txtHoTen) Or Me.txtHoTen 0 Then
       dieukienloc 
dieukienloc "[tbNhanvien.Tennhanvien] LIKE '*' AND "
   Else
       dieukienloc 
dieukienloc "[tbNhanvien.Tennhanvien] LIKE '*" & [Forms]![frm_Timkiem]![txtHoTen] & "*' AND "
   End If
   
   If IsNull
(Me.cboBoPhan) Or Me.cboBoPhan 0 Then
       dieukienloc 
dieukienloc "[tbMabophan.TenBophan] LIKE '*' AND "
   Else
       dieukienloc 
dieukienloc "[tbMaBophan.TenBophan] LIKE '" & [Forms]![frm_Timkiem]![cboBoPhan] & "' AND "
   End If
   
   If IsNull
(Me.txtLydo) Or Me.txtLydo 0 Then
       dieukienloc 
dieukienloc "[LyDo] LIKE '*' AND "
   Else
       dieukienloc 
dieukienloc "[LyDo] LIKE '*" & [Forms]![frm_Timkiem]![txtLydo] & "*' AND "
   End If
   
   Select 
Case Me.fraThoiGian.Value
       Case 1
           dieukienloc 
dieukienloc "Month([BatDau]) = " & [Forms]![frm_Timkiem]![cboThang]
       Case 2
           dieukienloc 
dieukienloc "(Month([BatDau])+2)\3 = " & [Forms]![frm_Timkiem]![cboQuy]
       Case 3
           If IsNull
(Me.txtTungay) Or IsNull(Me.txtDenngayThen
               dieukienloc 
Left(Trim(dieukienloc), Len(dieukienloc) - 4'Loai bo chu " AND"
           Else
               dieukienloc = "[BatDau] BETWEEN #" & [Forms]![frm_Timkiem]![txtTungay] & "# AND #" & [Forms]![frm_Timkiem]![txtDenngay] & "#"
           End If
   End Select
   
   strSQL = "SELECT B_ViecRieng.Manhanvien, tbNhanvien.Tennhanvien, tbMabophan.TenBophan, B_ViecRieng.SoNgayNghi, B_ViecRieng.BatDau, B_ViecRieng.KetThuc, B_ViecRieng.LyDo, B_ViecRieng.MaNhanVienDuyet1, B_ViecRieng.MaNhanVienDuyet2, B_ViecRieng.MaNhanVienDuyet3, B_ViecRieng.GhiChu " & _
            "FROM (tbMabophan INNER JOIN tbNhanvien ON tbMabophan.MaBophan = tbNhanvien.MaBophan) INNER JOIN B_ViecRieng ON tbNhanvien.MaNhanvien = B_ViecRieng.Manhanvien " & _
            "WHERE " & dieukienloc

   Me.sfrmTimKiem.Form.RecordSource = strSQL
End Sub 


-----------------------------------------------------------------------------
THAM KHẢO CÁCH ĐẶT TÊN CÁC CONTROL TRONG VBA

[Hình: ControlsNaming1.png]

[Hình: ControlsNaming2.png]
Chữ ký của ongke0711 If you BORN poor, it's not your mistake. But if you DIE poor, It's your mistake!
ღღღღღTài sản của ongke0711 (View All Items) ღღღღღ
Reply
Những người đã cảm ơn huuduy.duy , zinzin8x , maidinhdan
#5
(13-08-16, 03:06 PM)ongke0711 Đã viết: Bạn chú ý một số điểm sau:
- Điệu kiện dạng chuỗi (text) thì bạn phải đưa nó vào giữa 2 dấu nháy đơn " ' ".
- Nếu lấy tham số từ Form thì bạn phải thêm dấu  " & " trước nó thì vba mới hiểu.
- Chú ý cách đặt tên cho các control, tên trường cho thống nhất để dễ viết, sửa code. 
  Vd: Combobox -> nên là "cbo" chứ không phải "cbx"
        Table        -> nên là "tbl" chứ không phải "tb". Lúc 3 ký tự lúc 2 ký tự.

Link file: http://www.mediafire.com/download/8ktxfp...imKiem.mdb


Mã PHP:
Sub Loc()
   Dim dieukienloc As StringstrSQL As String
   If IsNull
(Me.txtHoTen) Or Me.txtHoTen 0 Then
       dieukienloc 
dieukienloc "[tbNhanvien.Tennhanvien] LIKE '*' AND "
   Else
       dieukienloc 
dieukienloc "[tbNhanvien.Tennhanvien] LIKE '*" & [Forms]![frm_Timkiem]![txtHoTen] & "*' AND "
   End If
   
   If IsNull
(Me.cboBoPhan) Or Me.cboBoPhan 0 Then
       dieukienloc 
dieukienloc "[tbMabophan.TenBophan] LIKE '*' AND "
   Else
       dieukienloc 
dieukienloc "[tbMaBophan.TenBophan] LIKE '" & [Forms]![frm_Timkiem]![cboBoPhan] & "' AND "
   End If
   
   If IsNull
(Me.txtLydo) Or Me.txtLydo 0 Then
       dieukienloc 
dieukienloc "[LyDo] LIKE '*' AND "
   Else
       dieukienloc 
dieukienloc "[LyDo] LIKE '*" & [Forms]![frm_Timkiem]![txtLydo] & "*' AND "
   End If
   
   Select 
Case Me.fraThoiGian.Value
       Case 1
           dieukienloc 
dieukienloc "Month([BatDau]) = " & [Forms]![frm_Timkiem]![cboThang]
       Case 2
           dieukienloc 
dieukienloc "(Month([BatDau])+2)\3 = " & [Forms]![frm_Timkiem]![cboQuy]
       Case 3
           If IsNull
(Me.txtTungay) Or IsNull(Me.txtDenngayThen
               dieukienloc 
Left(Trim(dieukienloc), Len(dieukienloc) - 4'Loai bo chu " AND"
           Else
               dieukienloc = "[BatDau] BETWEEN #" & [Forms]![frm_Timkiem]![txtTungay] & "# AND #" & [Forms]![frm_Timkiem]![txtDenngay] & "#"
           End If
   End Select
   
   strSQL = "SELECT B_ViecRieng.Manhanvien, tbNhanvien.Tennhanvien, tbMabophan.TenBophan, B_ViecRieng.SoNgayNghi, B_ViecRieng.BatDau, B_ViecRieng.KetThuc, B_ViecRieng.LyDo, B_ViecRieng.MaNhanVienDuyet1, B_ViecRieng.MaNhanVienDuyet2, B_ViecRieng.MaNhanVienDuyet3, B_ViecRieng.GhiChu " & _
            "FROM (tbMabophan INNER JOIN tbNhanvien ON tbMabophan.MaBophan = tbNhanvien.MaBophan) INNER JOIN B_ViecRieng ON tbNhanvien.MaNhanvien = B_ViecRieng.Manhanvien " & _
            "WHERE " & dieukienloc

   Me.sfrmTimKiem.Form.RecordSource = strSQL
End Sub 


-----------------------------------------------------------------------------
THAM KHẢO CÁCH ĐẶT TÊN CÁC CONTROL TRONG VBA

[Hình: ControlsNaming1.png]

[Hình: ControlsNaming2.png]

Cám ơn anh nhiều! Chúc anh cuối tuần vui vẻ
Chữ ký của huuduy.duy Xin chào, mình là huuduy.duy, Tham gia http://thuthuataccess.com/forum từ ngày 24-06 -13.
ღღღღღTài sản của huuduy.duy (View All Items) ღღღღღ
Reply
Những người đã cảm ơn
#6
Chào các anh chị
 Trên diễn đàn em có tìm được code tìm gợi ý nội dung cần tìm trong combobox, về áp dụng.
Nhưng cho em hỏi có cách nào khi click vô combobox thì sẽ hiện ra danh sách nội dung không (hiện tại phải gõ vài từ thì nó mới hiện ra) ý của em muốn là khi click vào thì sẽ hiện ra danh sách và gõ ký tự gợi ý sẽ hiện ra nội dung gần đúng. 
đồng thời xử lý lỗi khi chọn sai nội dung và chọn lại nội dung khác, hoặc hủy bỏ
Tải file
Trân trọng cảm ơn
Chữ ký của huuduy.duy Xin chào, mình là huuduy.duy, Tham gia http://thuthuataccess.com/forum từ ngày 24-06 -13.
ღღღღღTài sản của huuduy.duy (View All Items) ღღღღღ
Reply
Những người đã cảm ơn
#7
Trích dẫn:Bạn chú ý một số điểm sau:
- Điệu kiện dạng chuỗi (text) thì bạn phải đưa nó vào giữa 2 dấu nháy đơn " ' ".
- Nếu lấy tham số từ Form thì bạn phải thêm dấu  " & " trước nó thì vba mới hiểu.
- Chú ý cách đặt tên cho các control, tên trường cho thống nhất để dễ viết, sửa code. 
  Vd: Combobox -> nên là "cbo" chứ không phải "cbx"
        Table        -> nên là "tbl" chứ không phải "tb". Lúc 3 ký tự lúc 2 ký tự.


Link file: http://www.mediafire.com/download/8ktxfp...imKiem.mdb

1 / Anh cho em hỏi, theo như file này thì tổng số Record bảng việc riêng là 11, trong đó 
   Tháng 5 có 1 trường hợp
   Tháng 6 có 5 trường hợp 
   Tháng 7 có 5 trường hợp
Nhưng khi lọc theo cboThang,  thì trường  hợp chọn tháng 6 để lọc kết quả chỉ ra có 4 record, thiếu 1 trường hợp
Như vậy thì bị lỗi gì vậy anh, nhờ anh xem giúp.
2/ Trường em muốn tìm nhanh trong combobox khi gõ 1 vài ký gợi ý, thì làm như thế nào vậy anh( ở bài #6  ). 
Nhờ anh giúp đỡ
Trân trọng cảm ơn
Chữ ký của huuduy.duy Xin chào, mình là huuduy.duy, Tham gia http://thuthuataccess.com/forum từ ngày 24-06 -13.
ღღღღღTài sản của huuduy.duy (View All Items) ღღღღღ
Reply
Những người đã cảm ơn
#8
(16-08-16, 09:03 PM)huuduy.duy Đã viết: 1 / Anh cho em hỏi, theo như file này thì tổng số Record bảng việc riêng là 11, trong đó 
   Tháng 5 có 1 trường hợp
   Tháng 6 có 5 trường hợp 
   Tháng 7 có 5 trường hợp
Nhưng khi lọc theo cboThang,  thì trường  hợp chọn tháng 6 để lọc kết quả chỉ ra có 4 record, thiếu 1 trường hợp
Như vậy thì bị lỗi gì vậy anh, nhờ anh xem giúp.
2/ Trường em muốn tìm nhanh trong combobox khi gõ 1 vài ký gợi ý, thì làm như thế nào vậy anh( ở bài #6  ). 
Nhờ anh giúp đỡ
Trân trọng cảm ơn

1. Lỗi Record không hiển thị của tháng 6 là do trường [LyDo] của record đó đang là rỗng => câu lệnh của điều kiện lọc hiện tại sai, chưa tính đến trường hợp trường dữ liệu là NULL. Lỗi này cũng xảy ra cho các record khác nếu các trường [HoTen], [BoPhan]... có giá trị NULL.
Bạn sửa code của Sub Loc() như bên dưới. 
Mã PHP:
Sub Loc()
   Dim dieukienloc As StringstrSQL As String
   Dim lngLen 
As Long
   Const conJetDate 
"\#mm\/dd\/yyyy\#"
   
   If Not IsNull
(Me.txtHoTenThen
       dieukienloc 
dieukienloc "[tbNhanvien.Tennhanvien] LIKE '*" Me.txtHoTen "*' AND "
   End If
   
   If Not IsNull
(Me.cboBoPhanThen
       dieukienloc 
dieukienloc "[tbMaBophan.TenBophan] LIKE '" Me.cboBoPhan "' AND "
   End If
   
   If Not IsNull
(Me.txtLyDoThen
       dieukienloc 
dieukienloc "[LyDo] LIKE '*" Me.txtLyDo "*' AND "
   End If
   
   Select 
Case Me.fraThoiGian.Value
       Case 1
           If Not IsNull
(Me.cboThangThen
               dieukienloc 
dieukienloc "Month([BatDau]) = " Me.cboThang " AND "
           End If
       Case 2
           If Not IsNull
(Me.cboQuyThen
               dieukienloc 
dieukienloc "(Month([BatDau])+2)\3 = " Me.cboQuy " AND "
           End If
       Case 3
           If Not IsNull
(Me.txtTuNgayThen
               dieukienloc 
dieukienloc "[BatDau] >= " Format(Me.txtTuNgayconJetDate) & " AND "
           End If
           If Not IsNull(Me.txtDenNgayThen
               dieukienloc 
dieukienloc "[BatDau] < " Format(Me.txtDenNgayconJetDate) & " AND "
           End If
   End Select
   
   lngLen 
Len(dieukienloc) - 5
   If lngLen 
<= 0 Then
       MsgBox 
"Khong co dieu kien loc du lieu"vbInformation"Thông báo"
       strSQL "SELECT B_ViecRieng.Manhanvien, tbNhanvien.Tennhanvien, tbMabophan.TenBophan, B_ViecRieng.SoNgayNghi, B_ViecRieng.BatDau, B_ViecRieng.KetThuc, B_ViecRieng.LyDo, B_ViecRieng.MaNhanVienDuyet1, B_ViecRieng.MaNhanVienDuyet2, B_ViecRieng.MaNhanVienDuyet3, B_ViecRieng.GhiChu " _
               
"FROM (tbMabophan INNER JOIN tbNhanvien ON tbMabophan.MaBophan = tbNhanvien.MaBophan) INNER JOIN B_ViecRieng ON tbNhanvien.MaNhanvien = B_ViecRieng.Manhanvien"
       Me.sfrmTimKiem.Form.RecordSource strSQL
       Exit Sub
   Else
       dieukienloc 
Left$(dieukienloclngLen)
       strSQL "SELECT B_ViecRieng.Manhanvien, tbNhanvien.Tennhanvien, tbMabophan.TenBophan, B_ViecRieng.SoNgayNghi, B_ViecRieng.BatDau, B_ViecRieng.KetThuc, B_ViecRieng.LyDo, B_ViecRieng.MaNhanVienDuyet1, B_ViecRieng.MaNhanVienDuyet2, B_ViecRieng.MaNhanVienDuyet3, B_ViecRieng.GhiChu " _
               
"FROM (tbMabophan INNER JOIN tbNhanvien ON tbMabophan.MaBophan = tbNhanvien.MaBophan) INNER JOIN B_ViecRieng ON tbNhanvien.MaNhanvien = B_ViecRieng.Manhanvien " _
               
"WHERE " dieukienloc
       Me
.sfrmTimKiem.Form.RecordSource strSQL
   End 
If
   
End Sub 

2. Trường hợp vừa gõ tìm kiếm trực tiếp trong combobox, vừa click để hiển thị bình thường thì tôi chưa làm được.
Chữ ký của ongke0711 If you BORN poor, it's not your mistake. But if you DIE poor, It's your mistake!
ღღღღღTài sản của ongke0711 (View All Items) ღღღღღ
Reply
Những người đã cảm ơn huuduy.duy , maidinhdan
#9
(17-08-16, 12:43 AM)ongke0711 Đã viết: 2. Trường hợp vừa gõ tìm kiếm trực tiếp trong combobox, vừa click để hiển thị bình thường thì tôi chưa làm được.

Trường hợp này thì có cách nào khác (không nhất thiết combobox) để tìm kiếm tên của 1 nhân viên trong tblNhanvien để nhập thông tin nghỉ việc riêng không anh.
Trân trọng
Chữ ký của huuduy.duy Xin chào, mình là huuduy.duy, Tham gia http://thuthuataccess.com/forum từ ngày 24-06 -13.
ღღღღღTài sản của huuduy.duy (View All Items) ღღღღღ
Reply
Những người đã cảm ơn
#10
(17-08-16, 09:42 AM)huuduy.duy Đã viết: Trường hợp này thì có cách nào khác (không nhất thiết combobox) để tìm kiếm tên của 1 nhân viên trong tblNhanvien để nhập thông tin nghỉ việc riêng không anh.
Trân trọng

Thường thì dùng combobox để chọn mã nhân viên là tối ưu nhất trong thiết kế form. 
1 cách để tìm kiếm NV là sử dụng sự kiện "Not in List" của combobox để kiểm tra xem các ký tự mà người dùng gõ vào ô combobox có trong danh sách (tblNhanVien) hay không, nếu không có thì hiện lên một form tìm kiếm để bạn tìm nhân viên cần nhập liệu. 
Tôi gửi file demo cho bạn tham khảo. Trong file này có sử dụng form Tìm Kiếm của bạn MatTroiNguQuen mà tôi thấy rất hay nên mượn xài luôn.
Link file demo: http://www.mediafire.com/download/6qe8ea...InList.mdb

Còn nếu bạn vẫn muốn sử dụng tính năng tìm kiếm trực tiếp trong Combobox thì bạn sử dụng code như dưới đây. Code này của một cao thủ trên net viết ra khắc phục cái lỗi mà bạn đã đề cập với tôi. Post trước tôi không hướng dẫn cho bạn vì thấy bạn đang giai đoạn học hỏi cơ bản, nếu ngâm cứu cái này thì tẩu hỏa nên thôi. Còn nếu muốn ứng dụng luôn thì làm như sau:
- Copy đoạn code này vô Class Module, đặt tên là: FindAsYouTypeCombo
Mã PHP:
Option Compare Database
Option Explicit

'Class Module Name: FindAsYouTypeCombo
'
PurposeTurn any combobox into a "Find As You Type" 'Combobox
'
Created byMajP
'Demonstrates: OOP, and With Events
'
'Use: To use the class, you need a reference to DAO and code
'
similar to the following in a form's module.
'
Parmeters:
'  TheComboBox: Your Combobox object passed as an object
 FilterFieldNameThe name of the field to Filter as
'    string
 FilterFromStartDetermines if you filter a field that
'    starts with the text or if the text appears anywhere
   in the record.
'  HandleArrows:  Determines if up/down arrow keys stop the
   scrolling of the dropdown from affecting the filter.
'
'
*******STARTForm Code*******************
'
Option Compare Database
' Option Explicit
PRIVATE faytProducts As New FindAsYouTypeCombo
' Form_Open(Cancel As Integer)
  faytProducts.InitalizeFilterCombo Me.cmbProducts"ProductName"FalseTrue
' End Sub
'
' If you need to change the RowSource or requery the ComboBox, use this method:
faytProducts.RequeryList <optional new SQL statement>
'
'
******* ENDForm Code ******************

Private 
WithEvents mCombo   As Access.ComboBox
Private WithEvents mForm    As Access.Form
Private mFilterFieldName    As String
Private mRsOriginalList     As DAO.Recordset
Private mFilterFromStart    As Boolean

Private mHandleArrows       As Boolean  ' BS 10/13/2015
Private mAutoCompleteEnabled As Boolean ' 
BS 10/13/2015

'Public Property Get FilterComboBox() As Access.ComboBox
   Set FilterComboBox mCombo
'End Property
'
'Public Property Set FilterComboBox(TheComboBox As Access.ComboBox)
   Set mCombo TheComboBox
'End Property
'
'Public Property Get FilterFieldName() As String
   FilterFieldName mFilterFieldName
'End Property
'
'Public Property Let FilterFieldName(ByVal theFieldName As String)
   mFilterFieldName theFieldName
'End Property
'
'Public Sub DestroyObject()
   mRsOriginalList.Close
'    Set mRsOriginalList = Nothing
'
End Sub


Public Sub InitalizeFilterCombo(TheComboBox As Access.ComboBoxFilterFieldName As String _
   
Optional FilterFromStart False _
   
Optional HandleArrows As Boolean True)

   On Error GoTo ErrorHandler
   
   If Not TheComboBox
.RowSourceType "Table/Query" Then
       MsgBox 
"This class will only work with a combobox that uses a Table or Query as the Rowsource"
       Exit Sub
   End 
If
   
   Set mCombo 
TheComboBox
   Set mForm 
TheComboBox.Parent
   mFilterFieldName 
FilterFieldName
   mFilterFromStart 
FilterFromStart
   mForm
.OnCurrent "[Event Procedure]"
   mCombo.OnGotFocus "[Event Procedure]"
   mCombo.OnChange "[Event Procedure]"
   mCombo.AfterUpdate "[Event Procedure]"
  
   mHandleArrows 
HandleArrows
   If mHandleArrows 
True Then
       mCombo
.OnKeyDown "[Event Procedure]"  ' BS 10/13/2015
       mCombo.OnClick = "[Event Procedure]"    ' 
BS 10/13/2015
   End 
If
   
   Dim i 
As Long
   With mCombo
       
' The following was added to handle when delayed RowSource loading has been set up.  BS 1/7/2016
       If .RowSource = "" Then
           .RowSource = .Tag
       End If
       
      i = .ListCount  ' 
This forces the combo recordset to populate without the screen flashing or forcing Form_Load ' BS 5/9/2016

       .SetFocus       ' This forces Form_Load if it hasn't run yet.
'        i = .ListRows
       .ListRows 1   ' Reduce the amount of flashing from the next line.
       .Dropdown       ' This forces the combo recordset to populate.
       .ListRows i

       
.AutoExpand False
   End With
  
' This is an alternative method but it does not work if the RowSource has a
reference in it to a control on a form.
'    Set mRsOriginalList = CurrentDb.OpenRecordset(mCombo.RowSource, dbOpenSnapshot)
   Set mCombo.Recordset mRsOriginalList
      
   Set mRsOriginalList 
mCombo.Recordset.Clone
  
   Exit Sub
  
ErrorHandler
:
   MsgBox "Error #" Err.Number " - " Err.Description vbCrLf "in procedure InitalizeFilterCombo of clsFindAsYouTypeCombo"
   Debug.Print Err.NumberErr.Description
   Exit Sub
'    Resume Next
   Resume
End Sub

Private Sub Class_Terminate()
   Set mForm = Nothing
   Set mCombo = Nothing
   mRsOriginalList.Close
   Set mRsOriginalList = Nothing
End Sub

Private Sub FilterList()

   On Error GoTo ErrorHandler
   
   Dim rsTemp As DAO.Recordset
   Dim strText As String
   Dim strFilter As String
   
   If mAutoCompleteEnabled = False Then
       ' 
Don't filter when keystrokes like return, up/down, page up/down are entered.  BS 10/15/2015
   ' 
       Beep
       Exit Sub
   End 
If
   
   strText 
mCombo.Text
   If mFilterFieldName 
"" Then
       MsgBox 
"Must Supply A FieldName Property to filter list."
       Exit Sub
   End 
If
   If mFilterFromStart True Then
       strFilter 
mFilterFieldName " like '" strText "*'"
   Else
       strFilter 
mFilterFieldName " like '*" strText "*'"
   End If
   Set rsTemp mRsOriginalList.OpenRecordset
   rsTemp
.Filter strFilter
   Set rsTemp 
rsTemp.OpenRecordset
   
   If rsTemp
.RecordCount 0 Then
       Set mCombo
.Recordset rsTemp
   Else
       
' No records found for this filter.  Alert the user so they don't keep typing.
       Beep
   End 
If
   
   If Len
(strText) > 0 Then
       mCombo
.Dropdown
   Else
       
' Don't make the dropdown appear if the user just cleared the field.
   End If
   
   Exit Sub
 
ErrorHandler
:
   If Err.Number 3061 Then
       MsgBox 
"Will not Filter. Verify Field Name is Correct."
   Else
       MsgBox 
"Error #" Err.Number " - " Err.Description vbCrLf "in procedure FilterList of clsFindAsYouTypeCombo"
   End If
   
End Sub

Private Sub unFilterList()
   On Error GoTo ErrorHandler
   
   Set mCombo
.Recordset mRsOriginalList
   Exit Sub
   
ErrorHandler
:
   If Err.Number 3061 Then
       MsgBox 
"Will not Filter. Verify Field Name is Correct."
   Else
       MsgBox Err
.Number "  " Err.Description
   End 
If
End Sub

Private Sub mCombo_AfterUpdate()
   Call unFilterList
End Sub

Private Sub mCombo_Change()
   Call FilterList
End Sub

Private Sub mCombo_Click()
   ' When a value is selected from the list and populates the box, don't let that
   
' cause the list to be requeried.  BS 10/13/2015
   mAutoCompleteEnabled = False
End Sub

Private Sub mCombo_GotFocus()
'' BS 10/13/2015:  I commented out the next line because I don'
t like
'   this behavior when tabbing through controls on the form, especially
  when a couple of combo boxes are vertically stacked.
' This causes the dropdown to load when the SET event initializes, so it must be here unless it's called in InitalizeFilterCombo().
'    mCombo.Dropdown
End Sub

Private Sub mCombo_KeyDown(KeyCode As Integer, Shift As Integer)
Handle keys that affect the auto-complete feel of the combobox BS 10/13/2015

   If mHandleArrows 
True Then
' BS 10/15/2015:  I'm still not sure if I want this behavior At first it felt natural but now I'm not sure it's good.
'        If KeyCode = vbKeyReturn And mCombo.ListCount >= 1 And mAutoCompleteEnabled = True Then 'And mCombo.ListIndex = -1 Then
'            ' If the user pressed Enter and at least one value is in the list
'            ' then pick that item.
'            ' When this code fires sometimes the AfterUpdate event does not.
'            ' How can you force the AfterUpdate to fire?
'            Beep
           mCombo.value mCombo.ItemData(0)
'            'Debug.Print "KeyDown: " mCombomCombo.ListCountmCombo.ListIndex
'            mCombo.SetFocus
       End If
       
       Select 
Case KeyCode
           Case vbKeyDown
vbKeyUpvbKeyReturnvbKeyPageDownvbKeyPageUp
               
' When these special keys are hit they begin to select records
               ' 
from the dropdown list.  Without this, as soon as one record
               
' is selected (by highlighting it) then the entire filter is
               ' 
set to that item making it impossible to use the keyboard to
               
' scroll down and pick an item down in the list.
               mAutoCompleteEnabled = False
           Case Else
               mAutoCompleteEnabled = True
       End Select
   End If

End Sub

Private Sub mForm_Current()
   Call unFilterList
End Sub

Public Sub RequeryList(Optional pRowSource As String = "")
This class method only needs to be called when the combobox has a new rowsource,
' like when other controls affect what it should show, or the case of a cascading combobox.
'
### BEST PRACTICE ###
' Note that when using the Find-as-you-type combo, if you need to change the RowSource
you should pass the new rowsource to the RequeryList method and do not try to change
' the source from outside of the class module.  If you make changes outside of the class
it may appear to work for 3-4 iterations but fail after that.

   Dim i As Long
   
   On Error 
GoTo ErrorHandler

   DoCmd
.Hourglass True
   StatusBar 
"Refreshing " mCombo.Name "..."
   DoEvents
'    Debug.Print mCombo.Name;  'mCombo.RowSource
   
   If Not mRsOriginalList Is Nothing Then
       mRsOriginalList
.Close
   End 
If
   Set mRsOriginalList Nothing
   
   If Len
(pRowSource) > 0 Then
       mCombo
.RowSource pRowSource
   End 
If
   
   
' You have to do something here to force the recordset to requery.  Some people
   ' 
would argue that changing the RowSource forces a requery but I didn't experience
   ' 
that in this situation.
   i mCombo.ListCount    ' This forces the combo recordset to populate without the screen flashing or forcing Form_Load.  ' BS 5/9/2016
                           
' Without the line above you will get random errors with the recordset:
                           ' 
    Error #91 - Object variable or With block variable not set
   mCombo.Requery

'    Debug.Print mCombo.Recordset.RecordCount
   Set mRsOriginalList = mCombo.Recordset.Clone
   
This is an alternative method but it does not work if the RowSource has a
' reference in it to a control on a form.
   Set mRsOriginalList CurrentDb.OpenRecordset(pRowSourcedbOpenSnapshot)
'    Set mCombo.Recordset = mRsOriginalList


Exit_Sub:
   DoCmd.Hourglass False
   StatusBar ""

   Exit Sub

ErrorHandler:
   MsgBox "Error #" & Err.Number & " - " & Err.Description & vbCrLf & "in procedure RequeryList of clsFindAsYouTypeCombo"
   GoTo Exit_Sub
   
   Resume
End Sub


Private Sub StatusBar(pstrStatus As String)
http://www.mrexcel.com/forum/microsoft-access/233681-access-visual-basic-applications-application-statusbar.html

   Dim lvarStatus As Variant
   
   If pstrStatus 
"" Then
       lvarStatus 
SysCmd(acSysCmdClearStatus)
   Else
       lvarStatus 
SysCmd(acSysCmdSetStatuspstrStatus)
   End If
   
End Sub 

- Mở cái form có combobox bạn muốn tìm kiếm, ở sự kiện On Open bạn copy code này vô.
Mã PHP:
Option Compare Database
Public faytHovaten As New FindAsYouTypeCombo

Private Sub Form_Open(Cancel As Integer)
  faytHovaten.InitalizeFilterCombo Me.cboHovaten"Tennhanvien"False
End Sub 

- Xong.
Chữ ký của ongke0711 If you BORN poor, it's not your mistake. But if you DIE poor, It's your mistake!
ღღღღღTài sản của ongke0711 (View All Items) ღღღღღ
Reply
Những người đã cảm ơn huuduy.duy , maidinhdan


Có thể liên quan đến chủ đề
Chủ đề: Tác giả Trả lời: Xem: Bài mới nhất
  Tự động hiện Form khi loading hết thời gian ChiMai 1 34 Hôm qua, 08:59 PM
Bài mới nhất: ongke0711
Photo [Hỏi] Mở Form trên access 2007 báo lỗi jason 5 186 22-11-16, 09:23 AM
Bài mới nhất: jason
  Query hiện lên trên form? feeling 4 162 09-11-16, 09:49 PM
Bài mới nhất: toancvp
  [Help] Chỉnh giúp Form thống kê hoanghai902 2 123 28-10-16, 06:15 PM
Bài mới nhất: hoanghai902
  [Help] Dòng chữ chạy trên form báo đến ngày sinh nhật tronghieu9792 1 121 20-10-16, 09:30 AM
Bài mới nhất: lamvankhanh

Chuyển nhanh:


User(s) browsing this thread: 1 Guest(s)
Diễn Đàn Thơ Văn Thi Ẩm Lâu|Nhà Hàng Sông Thơ