Solved Smart combo boxes (1 Viewer)

 Public faytProducts As New FindAsYouTypeCombo
 
 Form_Open(Cancel As Integer)
   faytProducts.InitalizeFilterCombo Me.cmbProducts, "ProductName", False
 End Sub

'At the top of the code
Public faytArticulo As New FindAsYouTypeCombo

Private Sub Form_Open(Cancel As Integer)
   faytArticulo.InitalizeFilterCombo Me.CboArticulo, "Articulo", False
End Sub

Private Sub FilterList()
  On Error GoTo errLable
  Dim rsTemp As DAO.Recordset
  Dim strText As String
  Dim strFilter As String
  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 '" & Buscaacent(Nz(strText, Null)) & "*'"
  Else
    strFilter = mFilterFieldName & " like '*" & Buscaacent(Nz(strText, Null)) & "*'"
  End If
  Set rsTemp = mRsOriginalList.OpenRecordset
  rsTemp.Filter = strFilter
  Set rsTemp = rsTemp.OpenRecordset
  If rsTemp.RecordCount > 0 Then
    Set mCombo.Recordset = rsTemp
  End If
  mCombo.Dropdown
  Exit Sub
errLable:
  If Err.Number = 3061 Then
    MsgBox "Will not Filter. Verify Field Name is Correct."
  Else
    MsgBox Err.Number & "  " & Err.Description
  End If
End Sub

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.

'Parmaters:
'  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.
'
'*******START: Place Code like this in the Form *******************
'
' Option Compare Database
' Option Explicit
' Public faytProducts As New FindAsYouTypeCombo
'
' Form_Open(Cancel As Integer)
'   faytProducts.InitalizeFilterCombo Me.cmbProducts, "ProductName", False
' End Sub
'
'******* 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
Private mAutoCompleteEnabled As Boolean


'---------------------------------------- Properties --------------------------
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
Private Sub mCombo_Change()
  Call FilterList
End Sub
Public Property Get FilterFieldName() As String
  FilterFieldName = mFilterFieldName
End Property
Public Property Let FilterFieldName(ByVal theFieldName As String)
  mFilterFieldName = theFieldName
End Property
Public Property Get HandleArrows() As Boolean
  HandleArrows = mHandleArrows
End Property

Public Property Let HandleArrows(ByVal TheValue As Boolean)
  mHandleArrows = TheValue
End Property

'------------------------------------------- Handled Events ----------------
Private Sub mCombo_GotFocus()
   'If mAutoCompleteEnabled = True Then mCombo.Dropdown
End Sub
Private Sub mCombo_AfterUpdate()
  If Not mAutoCompleteEnabled Then Call unFilterList
End Sub
Private Sub mForm_Current()
  Call unFilterList
End Sub
Private Sub mForm_Close()
  ' Code provided by BenSacheri to keep Access from crashing
   Call Class_Terminate
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
    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


'----------------------------------  Procedures ----------------------------
Public Sub InitalizeFilterCombo(TheComboBox As Access.ComboBox, FilterFieldName As String, Optional FilterFromStart As Boolean = True, Optional HandleArrows As Boolean = True)
   On Error GoTo errLabel
   Dim rs As DAO.Recordset
   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
   mHandleArrows = HandleArrows
   mAutoCompleteEnabled = True
   If mHandleArrows = True Then
      mCombo.OnKeyDown = "[Event Procedure]"
      mCombo.OnClick = "[Event Procedure]"
   End If
   mFilterFieldName = FilterFieldName
   mFilterFromStart = FilterFromStart
   mForm.OnCurrent = "[Event Procedure]"
   mCombo.OnGotFocus = "[Event Procedure]"
   mCombo.OnChange = "[Event Procedure]"
   mCombo.AfterUpdate = "[Event Procedure]"
   mForm.OnClose = "[Event Procedure]"
   With mCombo
     .SetFocus
     .AutoExpand = False
   End With
   If mCombo.Recordset Is Nothing Then
     Set rs = CurrentDb.OpenRecordset(TheComboBox.RowSource)
     Set mCombo.Recordset = rs
   End If
   Set mRsOriginalList = mCombo.Recordset.Clone
   Exit Sub
errLabel:
    MsgBox Err.Number & " " & Err.Description
End Sub

Private Sub FilterList()
  On Error GoTo errLable
  Dim rsTemp As DAO.Recordset
  Dim strText As String
  Dim strFilter As String
  strText = mCombo.Text
  If mFilterFieldName = "" Then
    MsgBox "Must Supply A FieldName Property to filter list."
    Exit Sub
  End If
  If mAutoCompleteEnabled = False Then Exit Sub
  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
  End If
  mCombo.Dropdown
  Exit Sub
errLable:
  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 unFilterList()
  On Error GoTo errLable
  Set mCombo.Recordset = mRsOriginalList
   Exit Sub
errLable:
  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 Class_Terminate()
    Set mForm = Nothing
    Set mCombo = Nothing
    Set mRsOriginalList = Nothing
End Sub

  strText = mCombo.Text
  'Add the following afterwards
  strText = Replace(strText, "'", "''")
  strText = Replace(strText, "#", "[#]")

Public Function Buscaacent2(ByVal strText As String) As String
       
    Buscaacent2 = Replace(strText, "A", "[AÁÀÂÄaá]")
    Buscaacent2 = Replace(Buscaacent2, "E", "[EÉÈÊËeé]")
    Buscaacent2 = Replace(Buscaacent2, "I", "[IÍÌÎÏií]")
    Buscaacent2 = Replace(Buscaacent2, "O", "[OÓÒÔÖ0oó]")
    Buscaacent2 = Replace(Buscaacent2, "U", "[UÚÙÛÜuú]")

End Function

 strText = mCombo.Text
  'Add the following afterwards
  strText = Replace(strText, "'", "''")
  strText = Replace(strText, "#", "[#]")