Problemas en la Búsqueda de datos mediante cuadro de texto
El Problema que tengo es el siguiente, tengo una Tabla con el nombre LIBROS,y en ella hay la columna TITULO la cual es la que utilizo para la búsqueda, pero al introducir los datos en el cuadro de texto no puedo realizar la búsqueda hasta que no he puesto el nombre correcto.
El procedimiento que uso es el siguiente.
Option Compare Database
Private Sub Comando4_Click()
If Me.YaVeurem <> "" Then
If Len(Me.YaVeurem) > 30 Then
DoCmd.OpenForm "Llibres", , , CritErio, , acDialog
Else
DoCmd.OpenForm "Llibres", , , "Titulo='" & Me.YaVeurem & "'", , acDialog
End If
Else
MsgBox "Incluye un nombre para buscar", vbInformation, "Buscar"
Me.YaVeurem.SetFocus
End If
End Sub
Private Sub Lista19_Click()
Me.YaVeurem.Value = Me.Lista19.Column(0)
Me.YaVeurem.SetFocus
Me.Lista19.Visible = False
End Sub
Private Sub YaVeurem_Change()
CritErio = Rem_Google(Me.YaVeurem.Text, "", "*")
SQL = "SELECT LIBROS.TITULO FROM Llibres WERHE " & CritErio & ";"
Me.Lista19.RowSource = SQL
If Me.Lista19.ListCount > 0 Then
Me.Lista19.Visible = True
Else
Me.Lista19.Visible = False
End If
End Sub
Private Sub Form_Timer()
Me.Lista19.Visible = False
End Sub
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 = " (nombre) Like '*" & DescriFis & "*' "
Else
If DescriFis <> "DE" Or DescriFis <> "PARA" Then Rem_Google = Rem_Google & " (nombre) 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 & " (nombre) 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 & " (nombre) 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
También te mando la tabla en Vista Diseño pasada a Word, espero que te sirva para encontrar el problema.
<!--[if gte mso 9]><xml> <o:OfficeDocumentSettings> <o:AllowPNG/> </o:OfficeDocumentSettings></xml><![endif]-->
<!--[if gte mso 9]><xml> <w:WordDocument> <w:View>Normal</w:View> <w:Zoom>0</w:Zoom> <w:TrackMoves/> <w:TrackFormatting/> <w:HyphenationZone>21</w:HyphenationZone> <w:PunctuationKerning/> <w:ValidateAgainstSchemas/> <w:SaveIfXMLInvalid>false</w:SaveIfXMLInvalid> <w:IgnoreMixedContent>false</w:IgnoreMixedContent> <w:AlwaysShowPlaceholderText>false</w:AlwaysShowPlaceholderText> <w:DoNotPromoteQF/> <w:LidThemeOther>ES</w:LidThemeOther> <w:LidThemeAsian>X-NONE</w:LidThemeAsian> <w:LidThemeComplexScript>X-NONE</w:LidThemeComplexScript> <w:Compatibility> <w:BreakWrappedTables/> <w:SnapToGridInCell/> <w:WrapTextWithPunct/> <w:UseAsianBreakRules/> <w:DontGrowAutofit/> <w:SplitPgBreakAndParaMark/> <w:EnableOpenTypeKerning/> <w:DontFlipMirrorIndents/> <w:OverrideTableStyleHps/> </w:Compatibility> <m:mathPr> <m:mathFont m:val="Cambria Math"/> <m:brkBin m:val="before"/> <m:brkBinSub m:val="--"/> <m:smallFrac m:val="off"/> <m:dispDef/> <m:lMargin m:val="0"/> <m:rMargin m:val="0"/> <m:defJc m:val="centerGroup"/> <m:wrapIndent m:val="1440"/> <m:intLim m:val="subSup"/> <m:naryLim m:val="undOvr"/> </m:mathPr></w:WordDocument></xml><![endif]--><!--[if gte mso 9]><xml> <w:LatentStyles DefLockedState="false" DefUnhideWhenUsed="false" DefSemiHidden="false" DefQFormat="false" DefPriority="99" LatentStyleCount="371"> <w:LsdException Locked="false" Priority="0" QFormat="true" Name="Normal"/> <w:LsdException Locked="false" Priority="9" QFormat="true" Name="heading 1"/> <w:LsdException Locked="false" Priority="9" SemiHidden="true" UnhideWhenUsed="true" QFormat="true" Name="heading 2"/> <w:LsdException Locked="false" Priority="9" SemiHidden="true" UnhideWhenUsed="true" QFormat="true" Name="heading 3"/> <w:LsdException Locked="false" Priority="9" SemiHidden="true" UnhideWhenUsed="true"...