'-----------------------------------------------------------------------------------------------------------------------------------------------
' Fuente : https://access-global.net/funciones-de-dominio-de-alba/
'-----------------------------------------------------------------------------------------------------------------------------------------------
' Título : modAlbaDom
' Autor original : Alba Salvá
' Creado : 06/12/2010
' Propósito : establecer las 8 funciones de dominio con el mismo funcionamiento que las DFunctions de VBA (DMax, DMin, DFirst, DLast, DSum, DCount,
' DAvg, DLookUP) basándose en sentencias SQL
' ¿Cómo funciona? : los argumentos de las funciones son comunes y lo son a las DFunctions (Expresión, Dominio, criterios)
' El mçodulo está compuesto por 8 funciones_
' sAvg:calcula la media de un conjunto de registros
' sCount: cuenta los elementos de un conjunto de registros
' sSum:suma los elementos de un conjunto de registros
' sLookup:localiza un valor concreto de un conjunto de registros
' sMax: localiza el valor máximo de un conjunto de registros
' sMin: localiza el valor mínimo de un conjunto de registros
' sFirst: identifica el primer registro de un conjunto de registros
' sLast: identifica el último registro de un conjunto de registros
' Entradas : sCampo Obligatorio Valor string que representa la expresión del conjunto de datos, un campo
' sTabla Obligatorio Valor string que representa la expresión del conjunto de datos, una tabla o consulta
' sDonde Opcional Valor string que representa los criterios del conjunto de datos
' Salidas : Valores variant o long dependiendo de la función
'-----------------------------------------------------------------------------------------------------------------------------------------------
' Test : Para adaptar este código en tu aplicación puedes basarte en este procedimiento test. Copiar el bloque siguiente al
' portapapeles y pega en el editor de VBA. Descomentar la línea que nos interese y pulsar F5 para ver su funcionamiento.
' Este test
'
'Sub FuncionesDominioAlba_test()
'Dim resultado, ResultadoDFunctions
'Dim DblResultado As Double
'
''DAvg
' resultado = sAvg("Numero", "test")
' ResultadoDFunctions = DAvg("Numero", "test")
' DblResultado = FormatNumber(resultado, 2)
' Debug.Print "La media de Alba es" & Space(45 - Len("La media de Alba es")) & ": " & DblResultado
' DblResultado = FormatNumber(ResultadoDFunctions, 2)
' Debug.Print "La media de DFunctions es" & Space(45 - Len("La media de DFunctions es")) & ": " & DblResultado
' Debug.Print vbNullString
''DCount
' resultado = sCount("Numero", "test")
' ResultadoDFunctions = DCount("Numero", "test")
' Debug.Print "La tabla contiene según alba" & Space(45 - Len("La tabla contiene según Alba")) & ": " & resultado & " registros"
' Debug.Print "La tabla contiene según DFunctions" & Space(45 - Len("La tabla contiene según DFunctions")) & ": " & ResultadoDFunctions & " registros"
' Debug.Print vbNullString
''DSum
' resultado = sSum("Numero", "test")
' ResultadoDFunctions = DSum("Numero", "test")
' Debug.Print "La suma de los registros de Alba es" & Space(45 - Len("La suma de los registros de Alba es")) & ": " & resultado
' Debug.Print "La suma de los registros de DFunctions es" & Space(45 - Len("La suma de los registros de DFunctions es")) & ": " & resultado
' Debug.Print vbNullString
''DLookUp
' resultado = sLookup("Numero", "test", "idtest=2")
' ResultadoDFunctions = DLookup("Numero", "test")
' Debug.Print "El valor del idtest=2 según Alba es" & Space(45 - Len("El valor del idtest=2 según Alba es")) & ": " & resultado
' Debug.Print "El valor del idtest=2 según DFunctions es" & Space(45 - Len("El valor del idtest=2 según DFunctions es")) & ": " & resultado
' Debug.Print vbNullString
''DMax
' resultado = sMax("Numero", "test")
' ResultadoDFunctions = DMax("Numero", "test")
' Debug.Print "El valor máximo según Alba es" & Space(45 - Len("El valor máximo según Alba es")) & ": " & resultado
' Debug.Print "El valor máximo según DFunctions es" & Space(45 - Len("El valor máximo según DFunctions es")) & ": " & resultado
' Debug.Print vbNullString
''DMin
' resultado = sMin("Numero", "test")
' ResultadoDFunctions = DMin("Numero", "test")
' Debug.Print "El valor mínimo según Alba es" & Space(45 - Len("El valor mínimo según Alba es")) & ": " & resultado
' Debug.Print "El valor mínimo según DFunctions es" & Space(45 - Len("El valor mínimo según DFunctions es")) & ": " & resultado
' Debug.Print vbNullString
''DFirst
' resultado = sFirst("idtest", "test")
' ResultadoDFunctions = DFirst("Numero", "test")
' Debug.Print "El primer id de registro según Alba es" & Space(45 - Len("El primer id de registro según Alba es")) & ": " & resultado
' Debug.Print "El primer id de registro según DFunctions es" & Space(45 - Len("El primer id de registro según DFunctions es")) & ": " & resultado
' Debug.Print vbNullString
''DLast
' resultado = sLast("idtest", "test")
' ResultadoDFunctions = DLast("Numero", "test")
' Debug.Print "El último id de registro según Alba es" & Space(45 - Len("El último id de registro según Alba es")) & ": " & resultado
' Debug.Print "El último id de registro según DFunctions es" & Space(45 - Len("El último id de registro según DFunctions es")) & ": " & resultado
'
' End Sub
'-----------------------------------------------------------------------------------------------------------------------------------------------
Function sAvg(sCampo As String, sTabla As String, Optional sDonde As String) As Variant
'----------------------------------------------------------------------------------------------------------------------------------------------
' Fuente : https://access-global.net/funciones-de-dominio-de-alba/
'----------------------------------------------------------------------------------------------------------------------------------------------
' Título : SAvg
' Autor original : Alba Salvá
' Creado : 06/12/2010
' Propósito : Función que devuelve la media de valores de una tabla
' Argumentos : La sintaxis de la función consta de los siguientes argumentos
' Variable Modo Descripción
'---------------------------------------------------------------------------------------------------------------------------------------------
' sCampo Obligatorio Nombre del campo
' sTabla Obligatorio Nombre de la tabla
' sDonde Opcional Criterios adicionales para la búsqueda
'----------------------------------------------------------------------------------------------------------------------------------------------
' Retorno : Variant
'----------------------------------------------------------------------------------------------------------------------------------------------
' Test: : Para adaptar este código en tu aplicación puedes basarte en este procedimiento test. Copiar el bloque siguiente al
' portapapeles y pega en el editor de VBA. Descomentar la línea que nos interese y pulsar F5 para ver su funcionamiento.
'
' Sub sAvg_test()
' Dim media
'
' media = sAvg("campo", "tabla")
' Debug.Print "La media es: " & media
'
' End Sub
'-----------------------------------------------------------------------------------------------------------------------------------------------
Dim Rs As Recordset
Dim MiSQL As String
On Error GoTo sAvg_Error
MiSQL = "SELECT AVG(" & wzBracketString(sCampo, 0) & ") as Media FROM " & wzBracketString(sTabla, 0)
If Trim(sDonde) & "" <> "" Then
MiSQL = MiSQL & " WHERE " & sDonde
End If
Set Rs = CurrentDb.OpenRecordset(MiSQL)
If Rs.BOF And Rs.EOF Then
sAvg = Null
Else
Rs.MoveFirst
sAvg = Rs!media
End If
Rs.Close
Set Rs = Nothing
On Error GoTo 0
Exit Function
sAvg_Error:
MsgBox "Error " & Err.Number & " (" & Err.Description & ") en Function sAvg del Módulo modAlbaDom"
End Function
Function sCount(sCampo As String, sTabla As String, Optional sDonde As String = "") As Long
'--------------------------------------------------------------------------------------------------------
' Fuente : https://access-global.net/funciones-de-dominio-de-alba/
'--------------------------------------------------------------------------------------------------------
' Título : sCount
' Autor original : Alba Salvá
' Creado : 06/12/2010
' Propósito : Función que devuelve la cuenta de registros de una tabla
' Argumentos : La sintaxis de la función consta de los siguientes argumentos
' Variable Modo Descripción
'-------------------------------------------------------------------------------------------------------
' sCampo Obligatorio Nombre del campo
' sTabla Obligatorio Nombre de la tabla
' sDonde Opcional Criterios adicionales para la búsqueda
'--------------------------------------------------------------------------------------------------------
' Retorno : Long
'--------------------------------------------------------------------------------------------------------
Dim Rs As Recordset
Dim MiSQL As String
On Error GoTo sCount_Error
MiSQL = "SELECT COUNT(" & wzBracketString(sCampo, 1) & ") as MiCount FROM " & wzBracketString(sTabla, 1)
If Trim(sDonde & "") <> "" Then
MiSQL = MiSQL & " WHERE " & sDonde
End If
Set Rs = CurrentDb.OpenRecordset(MiSQL)
If Rs.BOF And Rs.EOF Then
sCount = 0
Else
Rs.MoveFirst
sCount = Rs!MiCount
End If
Rs.Close
Set Rs = Nothing
On Error GoTo 0
Exit Function
sCount_Error:
MsgBox "Error " & Err.Number & " (" & Err.Description & ") en Function sCount del Módulo modAlbaDom"
End Function
Function sFirst(sCampo As String, sTabla As String, Optional sDonde As String) As Variant
'--------------------------------------------------------------------------------------------------------
' Fuente : https://access-global.net/funciones-de-dominio-de-alba/
'--------------------------------------------------------------------------------------------------------
' Título : sFirst
' Autor original : Alba Salvá
' Creado : 06/12/2010
' Propósito : Función que devuelve el primer valor de una tabla
' Argumentos : La sintaxis de la función consta de los siguientes argumentos
' Variable Modo Descripción
'-------------------------------------------------------------------------------------------------------
' sCampo Obligatorio Nombre del campo
' sTabla Obligatorio Nombre de la tabla
' sDonde Opcional Criterios adicionales para la búsqueda
'--------------------------------------------------------------------------------------------------------
' Retorno : Long
'--------------------------------------------------------------------------------------------------------
Dim Rs As Recordset
Dim MiSQL As String
On Error GoTo sFirst_Error
MiSQL = "SELECT FIRST(" & wzBracketString(sCampo, 1) & ") as MiFirst FROM " & wzBracketString(sTabla, 1)
If Trim(sDonde & "") <> "" Then
MiSQL = MiSQL & " WHERE " & sDonde
End If
Set Rs = CurrentDb.OpenRecordset(MiSQL)
If Rs.BOF And Rs.EOF Then
sFirst = Null
Else
Rs.MoveFirst
sFirst = Rs!MiFirst
End If
Rs.Close
Set Rs = Nothing
On Error GoTo 0
Exit Function
sFirst_Error:
MsgBox "Error " & Err.Number & " (" & Err.Description & ") en Function sFirst del Módulo modAlbaDom"
Resume
End Function
Function sLast(sCampo As String, sTabla As String, Optional sDonde As String) As Variant
'--------------------------------------------------------------------------------------------------------
' Fuente : https://access-global.net/funciones-de-dominio-de-alba/
'--------------------------------------------------------------------------------------------------------
' Título : sLast
' Autor original : Alba Salvá
' Creado : 06/12/2010
' Propósito : Función que devuelve el último valor de una tabla
' Argumentos : La sintaxis de la función consta de los siguientes argumentos
' Variable Modo Descripción
'-------------------------------------------------------------------------------------------------------
' sCampo Obligatorio Nombre del campo
' sTabla Obligatorio Nombre de la tabla
' sDonde Opcional Criterios adicionales para la búsqueda
'--------------------------------------------------------------------------------------------------------
' Retorno : Variant
'--------------------------------------------------------------------------------------------------------
Dim Rs As Recordset
Dim MiSQL As String
On Error GoTo sLast_Error
MiSQL = "SELECT LAST(" & wzBracketString(sCampo, 1) & ") as MiLast FROM " & wzBracketString(sTabla, 1)
If Trim(sDonde & "") <> "" Then
MiSQL = MiSQL & " WHERE " & sDonde
End If
Set Rs = CurrentDb.OpenRecordset(MiSQL)
If Rs.BOF And Rs.EOF Then
sLast = Null
Else
Rs.MoveFirst
sLast = Rs!MiLast
End If
Rs.Close
Set Rs = Nothing
On Error GoTo 0
Exit Function
sLast_Error:
MsgBox "Error " & Err.Number & " (" & Err.Description & ") en Function sLast del Módulo modAlbaDom"
End Function
Function sLookup(sCampo As String, sTabla As String, Optional sDonde As String = "") As Variant
'--------------------------------------------------------------------------------------------------------
' Fuente : https://access-global.net/funciones-de-dominio-de-alba/
'--------------------------------------------------------------------------------------------------------
' Título : sLookup
' Autor original : Alba Salvá
' Creado : 06/12/2010
' Propósito : Función que devuelve el primer valor encontrado de una tabla
' Argumentos : La sintaxis de la función consta de los siguientes argumentos
' Variable Modo Descripción
'-------------------------------------------------------------------------------------------------------
' sCampo Obligatorio Nombre del campo
' sTabla Obligatorio Nombre de la tabla
' sDonde Opcional Criterios adicionales para la búsqueda
'--------------------------------------------------------------------------------------------------------
' Retorno : Variant
'--------------------------------------------------------------------------------------------------------
Dim Rs As Recordset
Dim MiSQL As String
On Error GoTo sLookup_Error
MiSQL = "SELECT " & wzBracketString(sCampo, 1) & " FROM " & wzBracketString(sTabla, 1)
If Trim(sDonde) & "" <> "" Then
MiSQL = MiSQL & " WHERE " & sDonde
End If
Set Rs = CurrentDb.OpenRecordset(MiSQL)
If Rs.BOF And Rs.EOF Then
sLookup = Null
Else
Rs.MoveFirst
sLookup = Rs.Fields(wzBracketString(sCampo, 1)).value
End If
Rs.Close
Set Rs = Nothing
On Error GoTo 0
Exit Function
sLookup_Error:
MsgBox "Error " & Err.Number & " (" & Err.Description & ") en Function sLookup del Módulo modAlbaDom"
Resume Next
End Function
Function sMax(sCampo As String, sTabla As String, Optional sDonde As String) As Variant
'--------------------------------------------------------------------------------------------------------
' Fuente : https://access-global.net/funciones-de-dominio-de-alba/
'--------------------------------------------------------------------------------------------------------
' Título : sMax
' Autor original : Alba Salvá
' Creado : 06/12/2010
' Propósito : Función que devuelve el máximo de los valores de una tabla
' Argumentos : La sintaxis de la función consta de los siguientes argumentos
' Variable Modo Descripción
'-------------------------------------------------------------------------------------------------------
' sCampo Obligatorio Nombre del campo
' sTabla Obligatorio Nombre de la tabla
' sDonde Opcional Criterios adicionales para la búsqueda
'--------------------------------------------------------------------------------------------------------
' Retorno : Variant
'--------------------------------------------------------------------------------------------------------
Dim Rs As Recordset
Dim MiSQL As String
On Error GoTo sMax_Error
MiSQL = "SELECT MAX(" & wzBracketString(sCampo, 1) & ") as MiMax FROM " & wzBracketString(sTabla, 1)
If Trim(sDonde & "") <> "" Then
MiSQL = MiSQL & " WHERE " & sDonde
End If
Set Rs = CurrentDb.OpenRecordset(MiSQL)
If Rs.BOF And Rs.EOF Then
sMax = Null
Else
Rs.MoveFirst
sMax = Rs!MiMax
End If
Rs.Close
Set Rs = Nothing
On Error GoTo 0
Exit Function
sMax_Error:
MsgBox "Error " & Err.Number & " (" & Err.Description & ") en Function sMax del Módulo modAlbaDom"
End Function
Function sMin(sCampo As String, sTabla As String, Optional sDonde As String) As Variant
'--------------------------------------------------------------------------------------------------------
' Fuente : https://access-global.net/funciones-de-dominio-de-alba/
'--------------------------------------------------------------------------------------------------------
' Título : sMin
' Autor original : Alba Salvá
' Creado : 06/12/2010
' Propósito : Función que devuelve el mínimo de los valores de una tabla
' Argumentos : La sintaxis de la función consta de los siguientes argumentos
' Variable Modo Descripción
'-------------------------------------------------------------------------------------------------------
' sCampo Obligatorio Nombre del campo
' sTabla Obligatorio Nombre de la tabla
' sDonde Opcional Criterios adicionales para la búsqueda
'--------------------------------------------------------------------------------------------------------
' Retorno : Variant
'--------------------------------------------------------------------------------------------------------
Dim Rs As Recordset
Dim MiSQL As String
On Error GoTo sMin_Error
MiSQL = "SELECT MIN(" & wzBracketString(sCampo, 1) & ") as MiMin FROM " & wzBracketString(sTabla, 1)
If Trim(sDonde & "") <> "" Then
MiSQL = MiSQL & " WHERE " & sDonde
End If
Set Rs = CurrentDb.OpenRecordset(MiSQL)
If Rs.BOF And Rs.EOF Then
sMin = Null
Else
Rs.MoveFirst
sMin = Rs!MiMin
End If
Rs.Close
Set Rs = Nothing
On Error GoTo 0
Exit Function
sMin_Error:
MsgBox "Error " & Err.Number & " (" & Err.Description & ") en Function sMin del Módulo modAlbaDom"
End Function
Function sSum(sCampo As String, sTabla As String, Optional sDonde As String) As Long
'--------------------------------------------------------------------------------------------------------
' Fuente : https://access-global.net/funciones-de-dominio-de-alba/
'--------------------------------------------------------------------------------------------------------
' Título : sSum
' Autor original : Alba Salvá
' Creado : 06/12/2010
' Propósito : Función que devuelve el mínimo de los valores de una tabla
' Argumentos : La sintaxis de la función consta de los siguientes argumentos
' Variable Modo Descripción
'-------------------------------------------------------------------------------------------------------
' sCampo Obligatorio Nombre del campo
' sTabla Obligatorio Nombre de la tabla
' sDonde Opcional Criterios adicionales para la búsqueda
'--------------------------------------------------------------------------------------------------------
' Retorno : Long
'--------------------------------------------------------------------------------------------------------
Dim Rs As Recordset
Dim MiSQL As String
On Error GoTo sSum_Error
MiSQL = "SELECT SUM(" & wzBracketString(sCampo, 1) & ") as Suma FROM " & wzBracketString(sTabla, 1)
If Trim(sDonde) & "" <> "" Then
MiSQL = MiSQL & " WHERE " & sDonde
End If
Set Rs = CurrentDb.OpenRecordset(MiSQL)
If Rs.BOF And Rs.EOF Then
sSum = 0
Else
Rs.MoveFirst
sSum = Rs!Suma
End If
Rs.Close
Set Rs = Nothing
On Error GoTo 0
Exit Function
sSum_Error:
MsgBox "Error " & Err.Number & " (" & Err.Description & ") en Function sSum del Módulo modAlbaDom"
End Function
1 Comment
Lo mejor es que una vez copiado el módulo en la BBDD, basta sustituir las “s” del principio del nombre de mis funciones y ponerles una “D”, y Access empezará a usarlas de inmediato; otra opción, quizás más compleja dependiendo del número de veces que llaméis a las funciones, es sustituir las “D” en vuestro código por “s”, así usareis las mias.