Já existe isso aqui
https://www.maximoaccess.com/t954-auto-completa-caixa-texto
e aqui
https://www.maximoaccess.com/t20171-autocompletar-textbox-baseado-em-tabela
Porém, estou organizando meus códigos e deixando-os o mais reaproveitáveis possível para novos projetos. Espero que esse genérico possa ajudar.
Em um módulo global
https://www.maximoaccess.com/t954-auto-completa-caixa-texto
e aqui
https://www.maximoaccess.com/t20171-autocompletar-textbox-baseado-em-tabela
Porém, estou organizando meus códigos e deixando-os o mais reaproveitáveis possível para novos projetos. Espero que esse genérico possa ajudar.
Em um módulo global
- Código:
Private arrLista
Public Sub fncCompletaTexto(ByVal strCampo As String, ByVal strTabela As String, Optional ByVal bytQtdMinCaracteres As Byte = 1)
' ----------------------------------------------------------------
' Autor : DamascenoJr. (contato@damascenojr.com.br)
' Data : 10/10/2020
' Propósito : Completar o texto de um textbox com base no campo de uma tabela.
' * No formulário chamador
' - Private booPausaCompletaTexto As Boolean
' * No controle chamador
' ** Evento 'Ao Alterar'
' - If booPausaCompletaTexto Then Exit Sub
' - Call fncCompletaTexto("cpNome", "tblClientes", 2)
' ** Evento 'Ao pressionar tecla'
' - booPausaCompletaTexto = (KeyAscii = vbKeyBack)
' ----------------------------------------------------------------
Dim objRs As DAO.Recordset
Dim i As Long
Dim j As Byte
If bytQtdMinCaracteres = 0 Then bytQtdMinCaracteres = 1
If Len(Nz(Screen.ActiveControl.Text, "")) < bytQtdMinCaracteres Then
Set arrLista = Nothing
Exit Sub
End If
If Not IsArray(arrLista) Then
Set objRs = CurrentDb.OpenRecordset("select " & strCampo & " " & _
"from " & strTabela & " " & _
"where " & strCampo & " like """ & Screen.ActiveControl.Text & "*"" " & _
"order by " & strCampo & ";", 4, 4)
If objRs.RecordCount > 0 Then
arrLista = objRs.GetRows(objRs.RecordCount)
Call objRs.Close: Set objRs = Nothing
Else
Call objRs.Close: Set objRs = Nothing
Exit Sub
End If
End If
For i = 0 To UBound(arrLista, 2)
If arrLista(0, i) Like (Screen.ActiveControl.Text & "*") Then
j = Len(Screen.ActiveControl.Text)
Screen.ActiveControl.Value = Screen.ActiveControl.Text & Mid(arrLista(0, i), j + 1)
Screen.ActiveControl.SelStart = j
Screen.ActiveControl.SelLength = Len(Screen.ActiveControl.Text) - j
Exit For
End If
Next i
End Sub
- Anexos
- bdCompletaTexto.zip
- Você não tem permissão para fazer download dos arquivos anexados.
- (53 Kb) Baixado 110 vez(es)