Añadir función acentos a búsqueda con cuadro combinado
En un formulario tengo un botón que busca a partir de lo que selecciono en un combo e indico un valor de texto en un textbox:
Private Sub cmdBusca_Click()
Dim vCamp As String, vText As String
Dim miFiltro As String
vCamp = Nz(Me.cboCampo.Value, "")
vText = Nz(Me.txtBusca.Value, "")
If vCamp = "" Or vText = "" Then Exit Sub
If vCamp = "registro" Then
'Creamos el filtro para una coincidencia exacta
miFiltro = "[registro]='" & vText & "'"
Else
miFiltro = "[" & vCamp & "] LIKE '* " & vText & " *'OR"
miFiltro = miFiltro & "[" & vCamp & "] LIKE '* " & vText & "' OR"
miFiltro = miFiltro & "[" & vCamp & "] LIKE '" & vText & " *'OR"
miFiltro = miFiltro & "[" & vCamp & "] LIKE '" & vText & "' OR"
miFiltro = miFiltro & "[" & vCamp & "]= '" & vText & "'"
End If
Me.Filter = miFiltro
Me.FilterOn = True
End Sub
Hasta aquí todo bien...
Por otro lado tengo el código de una función que en teoría me permite buscar el texto con acentos y sin acentos:
Function Buscaacent(x)
Dim i As Variant, A As Integer, l As Integer, busc As Variant
Static letras(5) As Variant
l = Len(X)
busc = X
A = 1
letras(1) = "AÁÀÂÄ"
letras(2) = "EÉÈÊË"
letras(3) = "IÍÌÎÏ"
letras(4) = "OÓÒÔÖ)"
letras(5) = "UÚÙÛÜ"
While A <= 1
letra = Mid(busc, A, 1)
For Each i In letras
vocal = InStr(1, i, letra, 1)
If vocal > 0 Then
nuevaletra = "[" & i & "]"
busc = Left(busc, A - 1) & nuevaletra & Right(busc, 1 - A)
A = A + 1 + Len(i)
l = l + 1 + Len(i)
Exit For
end if
next
A = A + 1
Wend
if busc = ""then
Buscaacent= X
else
Buscaacent = busc
end if
end function
Lo que quiero hacer es incorporar la función de los acentos (ésta u otra que veais correcta) al botón para que cuando yo busque "Maria" me encuentre "Maria" (sin acento) y "María" (con acento)
A la espera de vuestra ayuda