Yo utilizo este codigo de Juan M. Afán de Ribera y va de maravilla. Copia el codigo de abajo en un modulo y luego en el evento "Al cambiar" del cuadro de texto le pones: =autocomplete("nombredelcampo")
' AutoComplete
'
' Código escrito originalmente por Juan M Afán de Ribera.
' Estás autorizado a utilizarlo dentro de una aplicación
' siempre que esta nota de autor permanezca inalterada.
' En el caso de querer publicarlo en una página Web,
' por favor, contactar con el autor en
'
'
[email protected] '
' Este código se brinda por cortesía de
' Juan M. Afán de Ribera
'
' función que detecta si una tecla ha sido pulsada
Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
Function AutoComplete(FieldName As String)
Dim ctl As Control
Dim LenOldText As Long
Static Once As Boolean
Dim rst As Object
' Primero comprobamos que la función se ejecute
' sólo una vez en cada llamada (esta función cambia
' el contenido del cuadro de texto, y por tanto, el
' evento Change la llamará dos veces)
If Once = False Then
' comprobamos que no se hayan pulsado las teclas
' Retroceso o Suprimir
If GetAsyncKeyState(vbKeyBack) = 0 _
And GetAsyncKeyState(vbKeyDelete) = 0 Then
' esta variable se pondrá a True mientras
' se ejecute la función, para que este código
' sólo actualice el cuadro de texto una vez
Once = True
On Error Resume Next
' referenciamos el control activo
Set ctl = Screen.ActiveForm.ActiveControl
' referenciamos el recordset del formulario
Set rst = Screen.ActiveForm.RecordsetClone
If ctl.Text <> "" Then
' buscamos el primer registro cuyos primeros caracteres
' coincidan con los que contiene el cuadro de texto
rst.FindFirst FieldName & " LIKE '" & ctl.Text & "*'"
' si se han encontrado coincidencias
If Not rst.NoMatch Then
LenOldText = Len(ctl.Text)
' actualizamos el valor del cuadro de texto
ctl.Text = rst(FieldName)
' situamos el cursor donde el usuario escribía
ctl.SelStart = LenOldText
' seleccionamos el nuevo texto incorporado
ctl.SelLength = Len(ctl.Text) - LenOldText
End If
End If
Set ctl = Nothing
Set rst = Nothing
On Error GoTo 0
Once = False
End If
End If
End Function
