AUTOCOMPLETAR CON ADO ¡URGENTE!
Publicado por CHUCHO (6 intervenciones) el 02/12/2006 07:30:08
Hola que tal, estoy realizando un sistema de un control diario de las actas que se realizan en un registro civil, y en rato que estaba checando por aca encontre un codigo que es de autocompletar, lo baje y lo modifique para el sistema, para no hacer una busqueda sino que solo autocomplete la palabra, en este caso el numero de folio que se busca.
El codigo que descargué funciona bien, pero cuando lo quiero adaptar a mi formulario, si me muestra en una lista los posibles folios, pero cuando elijo uno, siempre me aparece el primer registro de la tabla no se porque, cualquiera que sea la opcion que yo elija siempre aparece el primer registro, ya busque en todo y no se si es el codigo, está mal la conexion con la base de datos o que este mal la base de datos no se, por favor ayudenme.
Aqui les dejo mi codigo para que lo chequen y me digan si estoy mal, por favor ayudenme es urgente:
Option Explicit
Dim CnN As New ADODB.Connection
Dim Rst As New ADODB.Recordset
Public Sub CnX()
On Local Error GoTo er
With CnN
.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & "Data Source=" & (CurDir(App.Path) & "\ACTA.MDB") & ";"
.Open
End With
Exit Sub
er:
MsgBox "Error Numero " & Err.Number & vbCrLf & Err.Description, vbCritical + vbOKOnly, Err.Source
End
End Sub
Private Sub Command1_Click()
Text2.Text = " "
Text3.Text = " "
Text4.Text = " "
Text5.Text = " "
Text6.Text = " "
Text7.Text = " "
Text8.Text = " "
Text2.SetFocus
End Sub
Private Sub Form_Load()
lst1.Height = 0: lst2.Height = 0
CnX
End Sub
Private Sub lst1_Click()
lst2.Selected(lst1.ListIndex) = True
End Sub
Private Sub lst1_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyEscape Then
lst1.Clear: lst1.Visible = False
lst2.Clear: lst2.Visible = False
End If
End Sub
Private Sub lst1_KeyPress(KeyAscii As Integer)
On Local Error Resume Next
If KeyAscii = 13 Then
Dim Rst As New ADODB.Recordset
With Rst
.Open "Select * From SEPNE", CnN, adOpenDynamic, adLockOptimistic
.Find "No DE FOLIO='" & lst1.Text & "'"
Text2.Text = .Fields(0)
Text3.Text = .Fields(1)
Text4.Text = .Fields(2)
Text5.Text = .Fields(3)
Text6.Text = .Fields(4)
Text7.Text = .Fields(5)
Text8.Text = .Fields(6)
.Close
lst1.Visible = False
lst2.Visible = False
End With
End If
End Sub
Private Sub lst2_Click()
lst1.Selected(lst2.ListIndex) = True
End Sub
Private Sub lst2_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyEscape Then
lst1.Clear: lst1.Visible = False
lst2.Clear: lst2.Visible = False
End If
End Sub
Private Sub Text2_Change()
On Local Error Resume Next
Text2.Text = UCase(Text2.Text)
Text2.SelStart = Len(Trim(Text2.Text))
lst1.Clear
lst2.Clear
If Len(Trim(Text2.Text)) <= 0 Then
lst1.Clear: lst2.Clear
lst1.Visible = False: lst2.Visible = False
Exit Sub
Else
With Rst
.Open "Select * From SEPNE", CnN, adOpenDynamic, adLockOptimistic
Do While Not .EOF
If Mid(.Fields(0), 1, Len(Text2)) = Mid(Text2, 1, Len(Text2)) Then
lst1.AddItem .Fields(0): lst2.AddItem .Fields(1)
End If
.MoveNext
Loop
.Close
End With
If lst1.ListCount > 0 Then
If lst1.ListCount > 3 Then
lst1.Height = lst1.ListCount * 200
lst2.Height = lst2.ListCount * 200
lst1.Visible = True: lst2.Visible = True
Else
lst1.Height = lst1.ListCount * 300
lst2.Height = lst2.ListCount * 300
lst1.Visible = True: lst2.Visible = True
End If
Else
lst1.Visible = False
lst2.Visible = False
End If
End If
End Sub
Private Sub Text2_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyEscape Then
lst1.Clear: lst1.Visible = False
lst2.Clear: lst2.Visible = False
End If
End Sub
Private Sub Text2_KeyPress(KeyAscii As Integer)
On Local Error Resume Next
If KeyAscii = 13 Then
Dim Rst As New ADODB.Recordset
With Rst
.Open "Select * From SEPNE", CnN, adOpenDynamic, adLockOptimistic
.Find "No DE FOLIO='" & Text2.Text & "'"
Text2.Text = .Fields(0)
Text3.Text = .Fields(1)
Text4.Text = .Fields(2)
Text5.Text = .Fields(3)
Text6.Text = .Fields(4)
Text7.Text = .Fields(5)
Text8.Text = .Fields(6)
.Close
lst1.Visible = False
lst2.Visible = False
End With
End If
End Sub
Private Sub Text2_KeyUp(KeyCode As Integer, Shift As Integer)
On Local Error Resume Next
Select Case KeyCode
Case vbKeyUp
lst1.SetFocus
lst1.ListIndex = lst1.ListIndex + 1
Case vbKeyDown
lst1.SetFocus
lst1.ListIndex = lst1.ListIndex + 1
End Select
End Sub
Private Sub lst2_KeyPress(KeyAscii As Integer)
On Local Error Resume Next
If KeyAscii = 13 Then
Dim Rst As New ADODB.Recordset
With Rst
.Open "Select * From SEPNE", CnN, adOpenDynamic, adLockOptimistic
.Find "No DE LIBRO='" & lst2.Text & "'"
Text2.Text = .Fields(0)
Text3.Text = .Fields(1)
Text4.Text = .Fields(2)
Text5.Text = .Fields(3)
Text6.Text = .Fields(4)
Text7.Text = .Fields(5)
Text8.Text = .Fields(6)
.Close
lst1.Visible = False
lst2.Visible = False
End With
End If
End Sub
Private Sub Text3_Change()
On Local Error Resume Next
Text3.Text = UCase(Trim(Text3.Text))
Text3.SelStart = Len(Trim(Text3.Text))
lst1.Clear
lst2.Clear
If Len(Trim(Text3.Text)) <= 0 Then
lst1.Clear: lst2.Clear
lst1.Visible = False: lst2.Visible = False
Exit Sub
Else
With Rst
.Open "Select * From SEPNE", CnN, adOpenDynamic, adLockOptimistic
Do While Not .EOF
If Mid(UCase(.Fields(1)), 1, Len(Text3)) = Mid(UCase(Text3), 1, Len(Text3)) Then
lst1.AddItem .Fields(0): lst2.AddItem .Fields(1)
End If
.MoveNext
Loop
.Close
End With
If lst2.ListCount > 0 Then
If lst2.ListCount > 3 Then
lst1.Height = lst1.ListCount * 200
lst2.Height = lst2.ListCount * 200
lst1.Visible = True: lst2.Visible = True
Else
lst1.Height = lst1.ListCount * 300
lst2.Height = lst2.ListCount * 300
lst1.Visible = True: lst2.Visible = True
End If
Else
lst1.Visible = False
lst2.Visible = False
End If
End If
End Sub
Private Sub Text3_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyEscape Then
lst1.Clear: lst1.Visible = False
lst2.Clear: lst2.Visible = False
End If
End Sub
Private Sub Text3_KeyPress(KeyAscii As Integer)
On Local Error Resume Next
If KeyAscii = 13 Then
Dim Rst As New ADODB.Recordset
With Rst
.Open "Select * From SEPNE", CnN, adOpenDynamic, adLockOptimistic
.Find "No DE LIBRO='" & Text3.Text & "'"
Text2.Text = .Fields(0)
Text3.Text = .Fields(1)
Text4.Text = .Fields(2)
Text5.Text = .Fields(3)
Text6.Text = .Fields(4)
Text7.Text = .Fields(5)
Text8.Text = .Fields(6)
.Close
lst1.Visible = False
lst2.Visible = False
End With
End If
End Sub
Private Sub Text3_KeyUp(KeyCode As Integer, Shift As Integer)
On Local Error Resume Next
Select Case KeyCode
Case vbKeyUp
lst2.SetFocus
lst2.ListIndex = lst2.ListIndex + 1
Case vbKeyDown
lst2.SetFocus
lst2.ListIndex = lst2.ListIndex + 1
End Select
End Sub
El codigo que descargué funciona bien, pero cuando lo quiero adaptar a mi formulario, si me muestra en una lista los posibles folios, pero cuando elijo uno, siempre me aparece el primer registro de la tabla no se porque, cualquiera que sea la opcion que yo elija siempre aparece el primer registro, ya busque en todo y no se si es el codigo, está mal la conexion con la base de datos o que este mal la base de datos no se, por favor ayudenme.
Aqui les dejo mi codigo para que lo chequen y me digan si estoy mal, por favor ayudenme es urgente:
Option Explicit
Dim CnN As New ADODB.Connection
Dim Rst As New ADODB.Recordset
Public Sub CnX()
On Local Error GoTo er
With CnN
.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & "Data Source=" & (CurDir(App.Path) & "\ACTA.MDB") & ";"
.Open
End With
Exit Sub
er:
MsgBox "Error Numero " & Err.Number & vbCrLf & Err.Description, vbCritical + vbOKOnly, Err.Source
End
End Sub
Private Sub Command1_Click()
Text2.Text = " "
Text3.Text = " "
Text4.Text = " "
Text5.Text = " "
Text6.Text = " "
Text7.Text = " "
Text8.Text = " "
Text2.SetFocus
End Sub
Private Sub Form_Load()
lst1.Height = 0: lst2.Height = 0
CnX
End Sub
Private Sub lst1_Click()
lst2.Selected(lst1.ListIndex) = True
End Sub
Private Sub lst1_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyEscape Then
lst1.Clear: lst1.Visible = False
lst2.Clear: lst2.Visible = False
End If
End Sub
Private Sub lst1_KeyPress(KeyAscii As Integer)
On Local Error Resume Next
If KeyAscii = 13 Then
Dim Rst As New ADODB.Recordset
With Rst
.Open "Select * From SEPNE", CnN, adOpenDynamic, adLockOptimistic
.Find "No DE FOLIO='" & lst1.Text & "'"
Text2.Text = .Fields(0)
Text3.Text = .Fields(1)
Text4.Text = .Fields(2)
Text5.Text = .Fields(3)
Text6.Text = .Fields(4)
Text7.Text = .Fields(5)
Text8.Text = .Fields(6)
.Close
lst1.Visible = False
lst2.Visible = False
End With
End If
End Sub
Private Sub lst2_Click()
lst1.Selected(lst2.ListIndex) = True
End Sub
Private Sub lst2_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyEscape Then
lst1.Clear: lst1.Visible = False
lst2.Clear: lst2.Visible = False
End If
End Sub
Private Sub Text2_Change()
On Local Error Resume Next
Text2.Text = UCase(Text2.Text)
Text2.SelStart = Len(Trim(Text2.Text))
lst1.Clear
lst2.Clear
If Len(Trim(Text2.Text)) <= 0 Then
lst1.Clear: lst2.Clear
lst1.Visible = False: lst2.Visible = False
Exit Sub
Else
With Rst
.Open "Select * From SEPNE", CnN, adOpenDynamic, adLockOptimistic
Do While Not .EOF
If Mid(.Fields(0), 1, Len(Text2)) = Mid(Text2, 1, Len(Text2)) Then
lst1.AddItem .Fields(0): lst2.AddItem .Fields(1)
End If
.MoveNext
Loop
.Close
End With
If lst1.ListCount > 0 Then
If lst1.ListCount > 3 Then
lst1.Height = lst1.ListCount * 200
lst2.Height = lst2.ListCount * 200
lst1.Visible = True: lst2.Visible = True
Else
lst1.Height = lst1.ListCount * 300
lst2.Height = lst2.ListCount * 300
lst1.Visible = True: lst2.Visible = True
End If
Else
lst1.Visible = False
lst2.Visible = False
End If
End If
End Sub
Private Sub Text2_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyEscape Then
lst1.Clear: lst1.Visible = False
lst2.Clear: lst2.Visible = False
End If
End Sub
Private Sub Text2_KeyPress(KeyAscii As Integer)
On Local Error Resume Next
If KeyAscii = 13 Then
Dim Rst As New ADODB.Recordset
With Rst
.Open "Select * From SEPNE", CnN, adOpenDynamic, adLockOptimistic
.Find "No DE FOLIO='" & Text2.Text & "'"
Text2.Text = .Fields(0)
Text3.Text = .Fields(1)
Text4.Text = .Fields(2)
Text5.Text = .Fields(3)
Text6.Text = .Fields(4)
Text7.Text = .Fields(5)
Text8.Text = .Fields(6)
.Close
lst1.Visible = False
lst2.Visible = False
End With
End If
End Sub
Private Sub Text2_KeyUp(KeyCode As Integer, Shift As Integer)
On Local Error Resume Next
Select Case KeyCode
Case vbKeyUp
lst1.SetFocus
lst1.ListIndex = lst1.ListIndex + 1
Case vbKeyDown
lst1.SetFocus
lst1.ListIndex = lst1.ListIndex + 1
End Select
End Sub
Private Sub lst2_KeyPress(KeyAscii As Integer)
On Local Error Resume Next
If KeyAscii = 13 Then
Dim Rst As New ADODB.Recordset
With Rst
.Open "Select * From SEPNE", CnN, adOpenDynamic, adLockOptimistic
.Find "No DE LIBRO='" & lst2.Text & "'"
Text2.Text = .Fields(0)
Text3.Text = .Fields(1)
Text4.Text = .Fields(2)
Text5.Text = .Fields(3)
Text6.Text = .Fields(4)
Text7.Text = .Fields(5)
Text8.Text = .Fields(6)
.Close
lst1.Visible = False
lst2.Visible = False
End With
End If
End Sub
Private Sub Text3_Change()
On Local Error Resume Next
Text3.Text = UCase(Trim(Text3.Text))
Text3.SelStart = Len(Trim(Text3.Text))
lst1.Clear
lst2.Clear
If Len(Trim(Text3.Text)) <= 0 Then
lst1.Clear: lst2.Clear
lst1.Visible = False: lst2.Visible = False
Exit Sub
Else
With Rst
.Open "Select * From SEPNE", CnN, adOpenDynamic, adLockOptimistic
Do While Not .EOF
If Mid(UCase(.Fields(1)), 1, Len(Text3)) = Mid(UCase(Text3), 1, Len(Text3)) Then
lst1.AddItem .Fields(0): lst2.AddItem .Fields(1)
End If
.MoveNext
Loop
.Close
End With
If lst2.ListCount > 0 Then
If lst2.ListCount > 3 Then
lst1.Height = lst1.ListCount * 200
lst2.Height = lst2.ListCount * 200
lst1.Visible = True: lst2.Visible = True
Else
lst1.Height = lst1.ListCount * 300
lst2.Height = lst2.ListCount * 300
lst1.Visible = True: lst2.Visible = True
End If
Else
lst1.Visible = False
lst2.Visible = False
End If
End If
End Sub
Private Sub Text3_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyEscape Then
lst1.Clear: lst1.Visible = False
lst2.Clear: lst2.Visible = False
End If
End Sub
Private Sub Text3_KeyPress(KeyAscii As Integer)
On Local Error Resume Next
If KeyAscii = 13 Then
Dim Rst As New ADODB.Recordset
With Rst
.Open "Select * From SEPNE", CnN, adOpenDynamic, adLockOptimistic
.Find "No DE LIBRO='" & Text3.Text & "'"
Text2.Text = .Fields(0)
Text3.Text = .Fields(1)
Text4.Text = .Fields(2)
Text5.Text = .Fields(3)
Text6.Text = .Fields(4)
Text7.Text = .Fields(5)
Text8.Text = .Fields(6)
.Close
lst1.Visible = False
lst2.Visible = False
End With
End If
End Sub
Private Sub Text3_KeyUp(KeyCode As Integer, Shift As Integer)
On Local Error Resume Next
Select Case KeyCode
Case vbKeyUp
lst2.SetFocus
lst2.ListIndex = lst2.ListIndex + 1
Case vbKeyDown
lst2.SetFocus
lst2.ListIndex = lst2.ListIndex + 1
End Select
End Sub
Valora esta pregunta


0