Iniciar sesiónCerrar
Correo:
Contraseña:
Entrar
Recordar sesión en este navegador
Iniciar sesiónIniciar sesiónCrear cuentaCrear cuenta
LWP » Foros » Access » Busqueda de datos que habra formulario

Access - Busqueda de datos que habra formulario

Volver
Nuevo Tema
<<>>
 
Vista:
Imágen de perfil de bryger
Val: 1
Ha disminuido su posición en 408 puestos en Access (en relación al último mes)
Gráfica de Access

Busqueda de datos que habra formulario

Publicado por bryger (15 intervenciones) el 29/06/2016 21:14:14
BUENAS TARDES TENGO UNA BD, la cual copie el codigo de busqueda pero como son muchos datos los cuales tengo que buscar y esta en red se me hace muy lenta la busqueda queria saber si me pueden ayudar con el codigo ya que en el que tengo me va mostrando los valores en una lista al estilo google y tambien me busca los que se parezcan necesita que los busque exacto y de no estar deberia de darme un mensaje lo que quiero es eliminar el cuadro lista anexo el codigo

la tabla se llama: tbclientes el cambo se llama :CEDULA_TITULAR
el formulario que habré se llama: tblclientes

y lo habre desde un boton llamado: Comando5
el cuadro de texto donde se coloca la busqueda se llama: txtBuscar
y debajo de el aparece un cuadro lista que es el que no quiero que aparezca se llama: lista2
anexo codigo: de jefferson Diaz

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
Option Compare Database
'***************************************************************

'&                                                            &*

'&                                                            &*

'&                                                            &*

'&                                                            &*

'&                 jeferson  (JJJT)                     &*

'&                 Cabimas - Venezuela            &*

'&                     Enero - 2010                   &*

'&                                                            &*

'&                                                            &*

'&                                                            &*

'&                                                            &*

'&                                                            &*

'***************************************************************

Dim CritErio As String
Private Sub Comando5_Click()
If Me.txtBuscar <> "" Then
    If Len(Me.txtBuscar) < 15 Then
    DoCmd.OpenForm "tblClientes", , , CritErio, , acDialog
 Else
    DoCmd.OpenForm "tblClientes", , , "CEDULA_TITULAR = '" & Me.txtBuscar & "'", , acDialog
 End If
Else
MsgBox "Incluya una CEDULA_TITULAR a buscar", vbInformation, "Buscar"
Me.txtBuscar.SetFocus
End If
End Sub
Private Sub Form_Timer()
Me.Lista2.Visible = False
End Sub
Private Sub Lista2_Click()
Me.txtBuscar.Value = Me.Lista2.Column(0)
Me.txtBuscar.SetFocus
Me.Lista2.Visible = False
End Sub
Private Sub txtBuscar_Change()
CritErio = Rem_Google(Me.txtBuscar.Text, " ", "*")
'CritErio = "CEDULA_TITULAR like '" & "*" & Me.txtBuscar.Text & "*" & "'"

SQL = "SELECT tblClientes.CEDULA_TITULAR FROM tblClientes WHERE  " & CritErio & " ;"
Me.Lista2.RowSource = SQL
If Me.Lista2.ListCount > 0 Then
Me.Lista2.Visible = True
Else
Me.Lista2.Visible = False
End If
End Sub
 
'Un amigo que sigue mi Pagina(Sitio) en Internet

'Me ha sugerido muy gustosamente mejorar el codigo de busqueda

'Comenta ARIEL ANTONIO JULIO GOMEZ

'de Cartagena - Colombia

 
'Ok, es el mismo formulario que tu tienes, pero en el query que tienes en el evento al cambiar, _

del cuadro de texto txtbuscar, le agregué a la variable criterio la siguiente funcion _
"CritErio = Rem_Google(Me.txtBuscar.Text, " ", "*")" que lo que hace es que ese criterio lo va _
armando a medida que vamos ingresando texto en el cuadro, permitiendo esto buscar un dato o CEDULA_TITULAR _
sin importar el orden en que lo escribamos en el cuadro. _
Esta funcion la encontre en la web del buho y la hizo Javier Mil en el ejemplo que él llamó Buscador2000.
 
Public Function Rem_Google(Texto As String, Letra As String, Cambio_Letra As String) As String
Dim Carac As String, CaracS As String, NroCarac, PrCarac, DescriFis As String, Letra_Asc As Double
On Error GoTo Rem_TextoTrap
        PrCarac = 1
        Texto = Trim$(Texto)
        NroCarac = Len(Texto)
        Letra_Asc = Asc(" ")
    Dim str2 As String
SigueCaracCli:
        Carac = Mid(Texto, PrCarac, 1)
        PrCarac = PrCarac + 1
        If PrCarac <= NroCarac Then If Mid(Texto, PrCarac, 1) = " " And Carac = "s" Then GoTo Esteno:
        If PrCarac <= NroCarac Then If Mid(Texto, PrCarac, 1) = " " And Carac = "S" Then GoTo Esteno:
        GoSub CaracFis:
        DescriFis = DescriFis & Carac
Esteno:
        If PrCarac <= NroCarac Then
            GoTo SigueCaracCli
        Else
 
            If DescriFis = "F-100" Or DescriFis = "F/100" Or DescriFis = "F100" Then DescriFis = "100"
 
            If Rem_Google = "" Then
                Rem_Google = " (CEDULA_TITULAR) Like '*" & DescriFis & "*' "
            Else
                If DescriFis <> "DE" Or DescriFis <> "PARA" Then Rem_Google = Rem_Google & " (CEDULA_TITULAR) Like '*" & DescriFis & "*' "
            End If
        End If
 
 
        Exit Function
 
        'AQUI SE PERMITE CAMBIAR UN TEXTO SIMILAR POR OTRO

CaracFis:
        Dim NN As String
        NN = Asc(Carac)
        If Asc(Carac) = Letra_Asc And PrCarac < NroCarac Then
            If DescriFis = "F-100" Or DescriFis = "F/100" Or DescriFis = "F100" Then DescriFis = "100"
            If DescriFis = "DE" Or DescriFis = "PARA" Then GoTo Parad:
            Rem_Google = Rem_Google & " (CEDULA_TITULAR) Like '*" & DescriFis & "*' AND "
            DescriFis = ""
            Carac = ""
            Return
        ElseIf Asc(Carac) = Letra_Asc And PrCarac = NroCarac Then
            If DescriFis = "F-100" Or DescriFis = "F/100" Or DescriFis = "F100" Then DescriFis = "100"
            If DescriFis = "DE" Or DescriFis = "PARA" Then GoTo Parad:
            Rem_Google = Rem_Google & " (CEDULA_TITULAR) Like '*" & DescriFis & "*' AND"
            DescriFis = ""
            Carac = ""
        End If
        Return
 
    Exit Function
 
Rem_TextoTrapExit:
Exit Function
 
Rem_TextoTrap:
If Err.Number = 5 Then
    GoTo Parad
Else
    str2 = "Error numero: " & Err.Number & "causado " & _
        "por una falla. Su descripcion es:" & vbCrLf & _
        Err.Description
    MsgBox str2, vbExclamation, _
        "Historia Clinica para Consultorio"
End If
Resume Rem_TextoTrapExit
 
 
Parad:
            DescriFis = ""
            Carac = ""
            Return
 
 
End Function

anexo link del creador https://sites.google.com/site/jjjt1973/Home/busqueda-o-buscador-como-el-google
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