SuperFiltro Access
Publicado por BMOTheGolem (8 intervenciones) el 13/03/2024 14:18:45
Buenas, tengo este modulo que saqué de un video de youtube, lo que hace es hacer un filtro de una lista, dejo el video donde lo cojí:
https://www.youtube.com/watch?v=vnmVcfBwtIw
pues he intentado modificar el codigo para a parte de hacer ese filtro, tenga un desplegable donde seleccionar por ejemplo el año de un campo, posteriormente dejo el codigo modificado por mi. Pero el problema es que cuando filtro primero desde el superfiltro y luego hago uso del desplegable, no funciona y solo filtra lo del desplegable ignorando lo que haya seleccionado en el cuadro de lista y ignorando tambien lo que he escrito en el cuadro de texto, ya que la variable sFiltro se vacia. pero si filtro primero el desplegable y luego el superfiltro si que filtra de forma simultanea. Mi intencion es que lo que ponga en el desplegable sea el primer filtro que aplique la consulta. Es decir, quiero que sea el mas restrictivo.
Dejo el codigo aqui:
Public Function BuscarEPF(ByVal ObjetoTipo As Byte, ByVal TextCambia As TextBox, ByVal TablaQuery As String, _
listBoxCampos As ListBox, Optional AListBox As Control, Optional mform As Form, Optional RepresentadaFiltro As String)
On Error GoTo hay_error
Dim frmcontrol As Form
Dim lscontrol As Control
Dim lscontrol_2 As Control
Dim varCampo As Variant
Dim sFiltro As String
Dim rFiltro As String
Set frmcontrol = mform
Set lscontrol = AListBox
Set lscontrol_2 = listBoxCampos
For Each varCampo In lscontrol_2.ItemsSelected()
sFiltro = sFiltro & "StrConv(" & lscontrol_2.ItemData(varCampo) & ", 2, 1042)" & _
" Like '*" & StrConv(Replace(TextCambia.Text, "'", "''"), 2, 1042) & "*'" & " OR "
Next varCampo
If RepresentadaFiltro <> "" Then
If sFiltro <> "" Then
rFiltro = "Representada = '" & RepresentadaFiltro & "' AND "
Else
rFiltro = "Representada = '" & RepresentadaFiltro & "' "
End If
Else
rFiltro = ""
End If
sFiltro = Mid(sFiltro, 1, Len(sFiltro) - 3)
strFiltroFinal = sFiltro
If ObjetoTipo = 1 Then
' Origen de datos para un cuadro de lista
lscontrol.RowSource = "SELECT * FROM [" & TablaQuery & "] WHERE " & rFiltro & sFiltro
Else
' Origen de datos para un formulario o subformulario
frmcontrol.RecordSource = "SELECT * FROM [" & TablaQuery & "] WHERE " & _
IIf(Len(sFiltro) > 0, sFiltro, 0)
End If
Debug.Print "Filtro: " & rFiltro & " " & sFiltro
Exit Function
hay_error_exit:
Exit Function
hay_error:
If Err.Number = 91 Then
MsgBox "Revise los parámetros..." & vbCrLf & vbCrLf & _
"Se require al menos un cuadro de texto o un formulario", vbCritical, "Error...."
ElseIf Err.Number = 5 Or Err.Number = 2185 Then
Resume Next
Else
MsgBox Err.Number & " " & Err.Description, vbCritical, "Cuidado..."
End If
Resume hay_error_exit
End Function
https://www.youtube.com/watch?v=vnmVcfBwtIw
pues he intentado modificar el codigo para a parte de hacer ese filtro, tenga un desplegable donde seleccionar por ejemplo el año de un campo, posteriormente dejo el codigo modificado por mi. Pero el problema es que cuando filtro primero desde el superfiltro y luego hago uso del desplegable, no funciona y solo filtra lo del desplegable ignorando lo que haya seleccionado en el cuadro de lista y ignorando tambien lo que he escrito en el cuadro de texto, ya que la variable sFiltro se vacia. pero si filtro primero el desplegable y luego el superfiltro si que filtra de forma simultanea. Mi intencion es que lo que ponga en el desplegable sea el primer filtro que aplique la consulta. Es decir, quiero que sea el mas restrictivo.
Dejo el codigo aqui:
Public Function BuscarEPF(ByVal ObjetoTipo As Byte, ByVal TextCambia As TextBox, ByVal TablaQuery As String, _
listBoxCampos As ListBox, Optional AListBox As Control, Optional mform As Form, Optional RepresentadaFiltro As String)
On Error GoTo hay_error
Dim frmcontrol As Form
Dim lscontrol As Control
Dim lscontrol_2 As Control
Dim varCampo As Variant
Dim sFiltro As String
Dim rFiltro As String
Set frmcontrol = mform
Set lscontrol = AListBox
Set lscontrol_2 = listBoxCampos
For Each varCampo In lscontrol_2.ItemsSelected()
sFiltro = sFiltro & "StrConv(" & lscontrol_2.ItemData(varCampo) & ", 2, 1042)" & _
" Like '*" & StrConv(Replace(TextCambia.Text, "'", "''"), 2, 1042) & "*'" & " OR "
Next varCampo
If RepresentadaFiltro <> "" Then
If sFiltro <> "" Then
rFiltro = "Representada = '" & RepresentadaFiltro & "' AND "
Else
rFiltro = "Representada = '" & RepresentadaFiltro & "' "
End If
Else
rFiltro = ""
End If
sFiltro = Mid(sFiltro, 1, Len(sFiltro) - 3)
strFiltroFinal = sFiltro
If ObjetoTipo = 1 Then
' Origen de datos para un cuadro de lista
lscontrol.RowSource = "SELECT * FROM [" & TablaQuery & "] WHERE " & rFiltro & sFiltro
Else
' Origen de datos para un formulario o subformulario
frmcontrol.RecordSource = "SELECT * FROM [" & TablaQuery & "] WHERE " & _
IIf(Len(sFiltro) > 0, sFiltro, 0)
End If
Debug.Print "Filtro: " & rFiltro & " " & sFiltro
Exit Function
hay_error_exit:
Exit Function
hay_error:
If Err.Number = 91 Then
MsgBox "Revise los parámetros..." & vbCrLf & vbCrLf & _
"Se require al menos un cuadro de texto o un formulario", vbCritical, "Error...."
ElseIf Err.Number = 5 Or Err.Number = 2185 Then
Resume Next
Else
MsgBox Err.Number & " " & Err.Description, vbCritical, "Cuidado..."
End If
Resume hay_error_exit
End Function
Valora esta pregunta
0