Visual Basic - AUTOCOMPLETAR CON ADO ¡URGENTE!

Life is soft - evento anual de software empresarial
 
Vista:

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
Valora esta pregunta
Me gusta: Está pregunta es útil y esta claraNo me gusta: Está pregunta no esta clara o no es útil
0
Responder
sin imagen de perfil
Val: 119
Ha disminuido 1 puesto en Visual Basic (en relación al último mes)
Gráfica de Visual Basic

RE:AUTOCOMPLETAR CON ADO ¡URGENTE!

Publicado por Chtristian (713 intervenciones) el 02/12/2006 20:11:14
Yo creo que el problema surge cuando el cursor esta del lado del servidor y no del cliente .
osea cuando haces la conexion con la base que si mal no vi vos la llamastes CNn
tendrias que poner
cnn.cursorlocation=aduserclient

queda nada mas que lo pruebes cualquier cosa preguntas de vuelta
saludos amigo
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar

RE:AUTOCOMPLETAR CON ADO ¡URGENTE!

Publicado por CHUCHO (6 intervenciones) el 04/12/2006 21:43:27
No me sale amigo, lo pongo asi mira:

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") & ";"
.CursorLocation = adUseclient
.Open
End With
Exit Sub
er:
MsgBox "Error Numero " & Err.Number & vbCrLf & Err.Description, vbCritical + vbOKOnly, Err.Source
End
End Sub

y sigue haciendo lo mismo

ojala tengas otra solucion
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar