ProInf.net

Option Compare Database
Option Explicit

'Módulo:  ModuloFiltros
'Autor:   Francisco Cascales <fco@proinf.net>
'Versión: 0.02
Function Filtrar(ParamArray controles()) As String
'Crea un filtro a partir del nombre y valor de los controles de formulario.
'Formatea adecuadamente los textos, las fecha y los valores decimales al formato SQL de MS-Access
'Ejemplos:
' Un ComboBox llamado IdCliente con el valor "ANTON": Filtrar([IdCliente]) --> "IdCliente='ANTON'"
' Un TextBox llamado FechaPedido con el valor #29/03/2007# : Filtrar([FechaPedido]) --> "FechaPedido=#03/27/2007#"
' Ambos filtros a la vez:  Filtrar([IdCliente],[FechaPedido])  -->  "(IdCliente='ANTON') AND (FechaPedido=#03/27/2007#)"
'29-III-2007, Francisco Cascales <fco@proinf.net>
    
    Dim control
    For Each control In controles
        Call AgregarFiltro(Filtrar, FiltrarPor(control.Name, control.Value))
    Next
    
End Function
Function Multifiltrar(ParamArray parejasCampoValor()) As String
'Crea un filtro a partir de parejas de campo y valor.
'El campo puede incluir el operador de comparación.
'Si se omite el operador de comparación en el campo se supone que es el de igualdad.
'Formatea adecuadamente los textos, las fecha y los valores decimales al formato SQL de MS-Access
'Ejemplos:
' Multifiltrar("IdCliente","ANTON","IdProducto",5)     --> "(IdCliente='ANTON') AND (IdProducto=5)"
' Multifiltrar("IdCliente","ANTON","IdProducto",null)  --> "(IdCliente='ANTON')"
' Multifiltrar("FechaPedido>=",date(),"FechaPedido<=",date()-7) --> "(FechaPedido>=#12/6/2007#) AND (FechaPedido<=#11/29/2007#)"
'6-XII-2007, Francisco Cascales <fco@proinf.net>

    Dim indice As Long
    
    For indice = LBound(parejasCampoValor) To UBound(parejasCampoValor) Step 2
        If indice + 1 > UBound(parejasCampoValor) Then Exit For
        Dim campo As String: campo = parejasCampoValor(indice)
        Dim valor As Variant: valor = parejasCampoValor(indice + 1)
        Call AgregarFiltro(Multifiltrar, FiltrarPor(campo, valor))
    Next
    
End Function
Function FiltrarPor(ByVal nombreCampo As String, ByVal valor As Variant) As String
'Crea un filtro, o cláusula WHERE de SQL, a partir del campo y del valor de ese campo
'teniendo en cuenta el tipo de datos: nulo, numérico, fecha, patrón o texto.
'Si se omite el operador de comparación en nombreCampo se supone que es el de igualdad.
'Ejemplos:
'  FiltrarPor("Precio",2.32)                --> "Precio=2.32"
'  FiltrarPor("Nombre grupo","Rolling's")   --> "[Nombre grupo]='Rolling''s'"
'  FiltrarPor("Nombre grupo>=","Rolling's") --> "[Nombre grupo]>='Rolling''s'"
'  FiltrarPor("Direccion","C*")             --> "Direccion LIKE 'C*'"

    Const COMILLA = "'"
    Const COMA = ","
    Const PUNTO = "."
    Const SIMBOLOS_COMPARACION = "<>="
  
    Dim indice As Integer
    Dim operador As String
    Dim indicePrimerSimboloComparacion As Integer

    'Quitar posibles espacios del principio y del final
    nombreCampo = Trim(nombreCampo)
    
    'Buscar si el campo ya incluye algún operador de comparación
    For indice = 1 To Len(SIMBOLOS_COMPARACION)
        indicePrimerSimboloComparacion = InStr(nombreCampo, Mid(SIMBOLOS_COMPARACION, indice, 1))
        If indicePrimerSimboloComparacion <> 0 Then Exit For
    Next
    operador = IIf(indicePrimerSimboloComparacion = 0, "=", "")
    
    'Poner el nombre del campo entre corchetes en el caso que esté
    '  formado por varias palabras y no estuviesen puesto ya los corchetes
    If InStr(nombreCampo, " ") And Left(nombreCampo, 1) <> "[" Then
        If indicePrimerSimboloComparacion = 0 Then
            nombreCampo = "[" & nombreCampo & "]"
        Else
            nombreCampo = "[" & Left(nombreCampo, indicePrimerSimboloComparacion - 1) & "]" & _
              Mid(nombreCampo, indicePrimerSimboloComparacion)
        End If
    End If

    If IsNull(valor) Then
        FiltrarPor = "" 'nombreCampo & " IS NULL"
    ElseIf valor = "" Then
        FiltrarPor = ""
    ElseIf IsNumeric(valor) Then
        'Cambiar la coma por punto para que coincida con el sistema estadounidense
        valor = Replace(Nz(valor, 0), COMA, PUNTO)
        FiltrarPor = nombreCampo & operador & valor
    ElseIf IsDate(valor) Then
        'Poner el formato de fecha al estilo estadounidense
        FiltrarPor = nombreCampo & operador & Format(CDate(valor), "\#mm/dd/yyyy\#")
    ElseIf InStr(valor, "*") Then 'Or InStr(valor, "?") Then
        'Duplicar las COMILLA simples
        valor = Replace(valor, COMILLA, COMILLA & COMILLA)
        operador = IIf(operador = "", "", " LIKE ")
        FiltrarPor = nombreCampo & operador & COMILLA & valor & COMILLA
    Else
        'Duplicar las COMILLA simples
        valor = Replace(valor, COMILLA, COMILLA & COMILLA)
        FiltrarPor = nombreCampo & operador & COMILLA & valor & COMILLA
    End If
End Function
Function UnionY(ParamArray criterios()) As String
'Une varios criterios con "AND"
'Ejemplos:
'  UnionY("IdCliente='ANTON'","IdCategoría=1")         -->  "(IdCliente='ANTON') AND (IdCategoría=1)"
'  UnionY(Filtrar([IdProveedor],Filtrar[IdCategoría])  -->  "(IdProveedor=4) AND (IdCategoría=23)"

    UnionY = "(" & Join(criterios, ") AND (") & ")"
End Function
Function UnionO(ParamArray criterios()) As String
'Une varios criterios con "OR"
'Ejemplos:
'  UnionO("IdCliente='ANTON'","IdCliente='BOLID'")   -->  "(IdCliente='ANTON') OR (IdCliente='BOLID')"
'  UnionO(Filtrar([IdCliente],Filtrar[IdProveedor])  -->  "(IdCliente='DUMON') OR (IdProveedor=7)"
    UnionO = "(" & Join(criterios, ") AND (") & ")"
End Function
Function AgregarFiltroPor(ByRef filtro As String, ByVal nombreCampo As String, ByVal valor As Variant, Optional ByVal operador As String = "AND") As String
'Agrega un nuevo criterio a un filtro a través del nombre del campo y su valor
'Ejemplo:
'  Dim filtro as String
'  call AgregarFiltro(filtro, "IdCliente", "ANTON") -->  "(IdCliente='ANTON')"
'  call AgregarFiltro(filtro, "FechaPedido", date)  -->  "(IdCliente='ANTON') AND (FechaPedido=#03/29/2007#)"

    AgregarFiltroPor = AgregarFiltro(filtro, FiltrarPor(nombreCampo, valor), operador)
End Function
Function AgregarFiltro(ByRef filtro As String, ByVal criterio As String, Optional ByVal operador As String = "AND") As String
'Agrega un nuevo criterio a un filtro. Utiliza el operador "AND" por omisión
'Ejemplo:
'  Dim filtro as String
'  Call AgregarFiltro(filtro "IdEmpleado=10")   -->  "(IdEmpleado=10)"
'  Call AgregarFiltro(filtro, "IdProducto=23")  -->  "(IdEmpleado=10) AND (IdProducto=23)"

    Const ESPACIO = " "

    criterio = Trim(criterio)

    If criterio = "" Then
        AgregarFiltro = filtro
    Else
        criterio = "(" & criterio & ")"
        If filtro = "" Then
            filtro = criterio
        Else
            filtro = filtro & ESPACIO & operador & ESPACIO & criterio
        End If
    End If
    
    AgregarFiltro = filtro
End Function