huuduy.duy > 31-07-16, 10:01 PM
ongke0711 > 01-08-16, 12:58 AM
huuduy.duy > 12-08-16, 10:11 PM
ongke0711 > 13-08-16, 03:06 PM
Sub Loc()
Dim dieukienloc As String, strSQL 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.txtDenngay) Then
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
huuduy.duy > 13-08-16, 03:16 PM
(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 String, strSQL 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.txtDenngay) Then
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
huuduy.duy > 15-08-16, 11:26 PM
huuduy.duy > 16-08-16, 09:03 PM
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ự.
ongke0711 > 17-08-16, 12:43 AM
(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
Sub Loc()
Dim dieukienloc As String, strSQL As String
Dim lngLen As Long
Const conJetDate = "\#mm\/dd\/yyyy\#"
If Not IsNull(Me.txtHoTen) Then
dieukienloc = dieukienloc & "[tbNhanvien.Tennhanvien] LIKE '*" & Me.txtHoTen & "*' AND "
End If
If Not IsNull(Me.cboBoPhan) Then
dieukienloc = dieukienloc & "[tbMaBophan.TenBophan] LIKE '" & Me.cboBoPhan & "' AND "
End If
If Not IsNull(Me.txtLyDo) Then
dieukienloc = dieukienloc & "[LyDo] LIKE '*" & Me.txtLyDo & "*' AND "
End If
Select Case Me.fraThoiGian.Value
Case 1
If Not IsNull(Me.cboThang) Then
dieukienloc = dieukienloc & "Month([BatDau]) = " & Me.cboThang & " AND "
End If
Case 2
If Not IsNull(Me.cboQuy) Then
dieukienloc = dieukienloc & "(Month([BatDau])+2)\3 = " & Me.cboQuy & " AND "
End If
Case 3
If Not IsNull(Me.txtTuNgay) Then
dieukienloc = dieukienloc & "[BatDau] >= " & Format(Me.txtTuNgay, conJetDate) & " AND "
End If
If Not IsNull(Me.txtDenNgay) Then
dieukienloc = dieukienloc & "[BatDau] < " & Format(Me.txtDenNgay, conJetDate) & " 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$(dieukienloc, lngLen)
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
huuduy.duy > 17-08-16, 09:42 AM
(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.
ongke0711 > 17-08-16, 10:44 PM
(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
Option Compare Database
Option Explicit
'Class Module Name: FindAsYouTypeCombo
'Purpose: Turn any combobox into a "Find As You Type" 'Combobox
'Created by: MajP
'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
' FilterFieldName: The name of the field to Filter as
' string
' FilterFromStart: Determines 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.
'
'*******START: Form Code*******************
'
' Option Compare Database
' Option Explicit
' PRIVATE faytProducts As New FindAsYouTypeCombo
' Form_Open(Cancel As Integer)
' faytProducts.InitalizeFilterCombo Me.cmbProducts, "ProductName", False, True
' End Sub
'
' If you need to change the RowSource or requery the ComboBox, use this method:
' faytProducts.RequeryList <optional new SQL statement>
'
'******* END: Form 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.ComboBox, FilterFieldName 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.Number, Err.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: " & mCombo, mCombo.ListCount, mCombo.ListIndex
' mCombo.SetFocus
' End If
Select Case KeyCode
Case vbKeyDown, vbKeyUp, vbKeyReturn, vbKeyPageDown, vbKeyPageUp
' 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(pRowSource, dbOpenSnapshot)
' 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(acSysCmdSetStatus, pstrStatus)
End If
End Sub
Option Compare Database
Public faytHovaten As New FindAsYouTypeCombo
Private Sub Form_Open(Cancel As Integer)
faytHovaten.InitalizeFilterCombo Me.cboHovaten, "Tennhanvien", False
End Sub