La página Web de Emilio Sancha
Inicio    |   Access    |   Excel    |    Visual Script    |   Enlaces    |   Búsquedas    |   Apuntes    |   Libro de Visitas

'***********************************************************************************
'* Función que calcula el valor máximo de una tabla y un campo pasados como parámetros
'* uso: AutoNumerico("Pendientes","id")
'* ESH 09/09/00 15:50
'***********************************************************************************

Public Function AutoNumerico(strTabla As String, strCampo As String) As Integer

Dim dbs As Database, _
    rst As Recordset, _
    strMaximo As String

' creo una cadena con la select para obtener el valor más alto del campo
strMaximo = "SELECT Max(" & strCampo & ") as Mayor FROM    " & strTabla
Set dbs = CurrentDb
Set rst = dbs.OpenRecordset(strMaximo)   ' abro un recordset con esa cadena
If IsNull(rst!Mayor) Then
    AutoNumerico = 1                     ' si la tabla está vacía
Else
    AutoNumerico = rst!Mayor + 1         ' devuelvo el valor incrementado en uno
End If

' cierro el recordset
rst.Close
Set rst = Nothing
Set dbs = Nothing
End Function     ' AutoNumerico

'***********************************************************************************
'* Función que calcula el valor máximo de una tabla y un campo pasados como parámetros,
'* teniendo en cuenta el prefijo del campo, que irá separado por una    "/".
'* el campo deberá ser de texto
'* uso: AutoNumerico2("Pendientes","id")
'* Para tablas nuevas o cambio de prefijo, se puede pasar un prefijo opcional    (sin "/")
'* en cuyo caso comienza a contar desde 1
'* uso: AutoNumerico2("Pendientes","id", "2002")
'* ESH 18/04/01 19:15
'***********************************************************************************

Public Function AutoNumerico2(strTabla As String, strCampo As String, Optional    strPrefijo As String) As String

Dim dbs As Database, _
    rst As Recordset,    _
    strMaximo As String

Set dbs = CurrentDb

If strPrefijo = "" Then
    Set rst = dbs.OpenRecordset(strTabla,    dbOpenDynaset)
    If Not rst.EOF()    And Not rst.BOF() Then
         rst.MoveLast
         strPrefijo = Left(rst(strCampo), InStr(rst(strCampo),    "/"))
         rst.Close
     End If   ' Not rst.EOF() And Not rst.BOF()
Else
     strPrefijo = strPrefijo    & "/"
     AutoNumerico2 =    strPrefijo & 1
     Exit Function
End If  ' IsEmpty(strPrefijo)

' creo una cadena con la select para obtener el valor más alto del campo
strMaximo = "SELECT Max(Val(Mid(" & strCampo & ",InStr(" & strCampo & ",'/')+1))) as Mayor FROM " & strTabla
Set rst = dbs.OpenRecordset(strMaximo)                    ' abro un recordset con esa cadena

If IsNull(rst!Mayor) Then                                 ' si es nulo lo hago 1
    AutoNumerico2 =    strPrefijo & 1
Else
    AutoNumerico2 =    strPrefijo & rst!Mayor + 1         ' devuelvo el valor incrementado en uno
End If       ' IsNull(rst!Mayor)

' cierro el recordset
rst.Close
Set rst = Nothing
Set dbs = Nothing

End Function      ' AutoNumerico2

'***********************************************************************************
'* Función que calcula el valor máximo de una tabla (LineasFactura) y un campo (Linea),
'* para un campo clave (NumFactura) que cumple una condición (01-2001)
'* es el caso típico de numeración de líneas de factura    o boletín.
'* uso: txtNumero = AutoNumerico3("LineasFactura", "Linea", "NumFactura", "01-2001")
'* ESH 01/05/01 10:32
'***********************************************************************************

Public Function AutoNumerico3(strTabla As String, strCampo As String, strClave As String, strValorClave As String) As Integer

Dim dbs As Database, _
    rst As Recordset, _
    strMaximo As String

' creo una cadena con la select para obtener el valor más alto del campo
strMaximo = "SELECT Max(" & strCampo & ") as Mayor FROM " & strTabla
strMaximo = strMaximo & " WHERE " & strClave & " = '" & strValorClave & "'"
Set dbs = CurrentDb
Set rst = dbs.OpenRecordset(strMaximo)          ' abro un recordset con esa cadena
If IsNull(rst!Mayor) Then
    AutoNumerico3 = 1                           '    si la tabla está vacía
Else
    AutoNumerico3 = rst!Mayor + 1               ' devuelvo el valor incrementado en uno
End If

' cierro el recordset
rst.Close
Set rst = Nothing
Set dbs = Nothing
End Function          ' AutoNumerico3

'***********************************************************************************
'* Función que calcula el valor máximo de una tabla y un campo pasados como parámetros,
'* teniendo en cuenta el Sufijo del campo, que irá separado por un "-".
'* el campo deberá ser de texto
'* uso: AutoNumerico4("Pendientes","id")
'* Para tablas nuevas o cambio de sufijo, se puede pasar un sufijo opcional (sin "-")
'* en cuyo caso comienza a contar desde 1
'* uso: AutoNumerico4("Pendientes","id", "2002")
'* ESH 09/05/01 18:15
'***********************************************************************************

Public Function AutoNumerico4(strTabla As String, strCampo As String, Optional strSufijo As String) As String

Dim dbs As Database, _
    rst As Recordset, _
    strMaximo As String

Set dbs = CurrentDb

If strSufijo = "" Then
   Set rst = dbs.OpenRecordset(strTabla, dbOpenDynaset)
   If Not rst.EOF() And Not rst.BOF() Then
        rst.MoveLast
        strSufijo = Right(rst(strCampo), InStr(rst(strCampo), "-"))
        rst.Close
   End If           ' Not rst.EOF() And Not rst.BOF()
Else
   AutoNumerico4 = "0001-" & strSufijo
        Exit Function
End If       ' strSufijo = ""

' creo una cadena con la select para obtener el valor más alto del campo
strMaximo = "SELECT Max(Val(left(numfactura,InStr(numfactura,'-')-1))) as Mayor FROM " & strTabla
Set rst = dbs.OpenRecordset(strMaximo)                 ' abro un recordset con esa cadena

If IsNull(rst!Mayor) Then                              ' si es nulo lo hago 1
    AutoNumerico4 = "0001" & strSufijo
Else
    AutoNumerico4 =Format(rst!Mayor + 1, "0000") & strSufijo          ' devuelvo el valor incrementado en uno
End If ' IsNull(rst!Mayor)

' cierro el recordset
rst.Close
Set rst = Nothing
Set dbs = Nothing

End Function       ' AutoNumerico4

'***********************************************************************************
'* función que busca el primer número de orden libre en la tabla    y campo pasados como parámetros
'* uso: intCodigo = BuscarLibre("Tabla1","id")
'* ESH 10/04/01 18:35
 '***********************************************************************************

Public Function BuscarLibre(strTabla As String, strCampo As String) As Long
' declaraciones
Dim dbs As Database
	rst As Recordset
	strSQL As String
   lngAnterior As Long

' crear recordset
strSQL = "SELECT " & strCampo & " FROM " & strTabla & " ORDER BY " & strCampo & " ASC"
Set dbs = CurrentDb
Set rst = dbs.OpenRecordset(strSQL, dbOpenDynaset)

lngAnterior = 1

' busco el primer hueco libre
With rst
   ' si la tabla está vacía
   If .EOF And .BOF Then
       BuscarLibre    = 1
       Exit Function
  	Else
   ' si el primer registro es distinto de 1
  	If rst(strCampo) > 1 Then
      	BuscarLibre = 1
        	Exit Function
    	End If        ' (IsNull(rst(strCampo)) Or rst(strCampo) > 1)
   End If     ' Not .EOF And Not .BOF
   
   ' si el primer registro esta vacío
   If IsNull(rst(strCampo)) Then
       MsgBox "Hay al menos un registro NULO, corrigelo antes de continuar", vbOKOnly + vbCritical, "ATENCION"
       Exit Function
   End If     ' IsNull(rst(strCampo))
   
   Do
       Select Case rst(strCampo)
           ' si el siguiente es correlativo
           Case Is = lngAnterior    + 1
               lngAnterior = rst(strCampo)
               .MoveNext
           ' si el siguiente está libre
           Case Is > lngAnterior    + 1
               BuscarLibre = lngAnterior + 1
               Exit Do
           Case Is = lngAnterior
           ' si es igual (primer caso)
               lngAnterior = rst(strCampo)
               .MoveNext
       End Select       ' rst(strCampo)
   
   Loop While Not .EOF

   ' si hemos llegado al fin de la tabla y estaban todos ocupados
   If .EOF Then BuscarLibre = lngAnterior + 1
End With       ' rst

' cierro recordsets y base de datos
rst.Close
dbs.Close
Set rst = Nothing
Set dbs = Nothing

End Function       ' BuscarLibre

'*******************************************************************************
'* Autonumerico5
'* Calcula el próximo número a asignar a un registro, partiendo del almacenado
'* en una tabla Numeros cuya estructura será
'*     Campo Tabla     Alfanumérico Indexado sin duplicados
'*     Campo Numero    Entero Largo
'* dicha tabla contendrá un registro para cada tabla que cuente con un
'* campo autonumérico controlado
'* Argumentos:
'* uso: Autonumerico5 "Facturas"
'* ESH 31/08/04 18:39
'******************************************************************************* 

Private Function Autonumerico5(strTabla As String) As Long
Dim rst As DAO.Recordset, _
strSQL As String, _
lngNumero As Long
   
' abro un recordset con el ultimo número guardado
On Error GoTo Autonumerico5_TratamientoErrores

strSQL = "SELECT * FROM Numeros WHERE Tabla = '" & strTabla & "'"

Set rst = CurrentDb.OpenRecordset(strSQL, dbOpenDynaset)

' como precaución, no debería ocurrir, pero por si acaso, me aseguro de que me devuelve datos
If Not rst.EOF And Not rst.BOF Then
    ' meto en una variable el ultimo número guardado
    lngNumero = rst!Numero
End If

' incremento en uno el número
lngNumero = lngNumero + 1

' edito el registro
rst.Edit
' cambio el número anterior por el nuevo
rst!Numero = lngNumero
' guardo el registro
rst.Update

' cierro el recordset
If Not rst Is Nothing Then
    rst.Close
    Set rst = Nothing
End If

Autonumerico5 = lngNumero

Autonumerico5_Salir:
   On Error GoTo 0
   Exit Function
   
Autonumerico5_TratamientoErrores:

MsgBox "Error " & Err.Number & " en proc. Autonumerico5 de Módulo Módulo1 (" & Err.Description & ")", vbOKOnly + vbCritical
   GoTo Autonumerico5_Salir

End Function ' Autonumerico5

'*******************************************************************************
'* AutoNumericoAleatorio
'* genera un número aleatorio dentro del rango solicitado verificando que no
'* exista previamente en el campo y tabla indicadas
'* Argumentos: strTabla  => Tabla en que se va a insertar el valor
'*             strCampo  => Campo en el que se va a insertar el valor
'*             lngMinimo => Valor mínimo
'*             lngMaximo => Valor máximo
'* uso: AutoNumericoAleatorio "LaTabla", "ElCampo", 0, 999999
'* ESH 28/01/07 17:53
'******************************************************************************* 
Public Function AutoNumericoAleatorio(strTabla As String, strCampo As String, lngMinimo As Long, lngMaximo As Long) As Long

Dim lngNuevo As Long, _
    rst As DAO.Recordset, _
    strSQL As String
         
On Error GoTo AutoNumericoAleatorio_TratamientoErrores 
' abro un recordset con el campo y la tabla indicados 
strSQL = "SELECT " & strCampo
strSQL = strSQL & " FROM " & strTabla

Set rst = CurrentDb.OpenRecordset(strSQL, dbOpenDynaset)

If Not (rst.EOF And rst.BOF) Then
   Do
      ' genero aleatoriamente un valor dentro del rango 
      lngNuevo = Int((lngMaximo - lngMinimo + 1) * Rnd + lngMinimo)
      ' verifico si existe en la tabla 
      rst.FindFirst strCampo & " = " & lngNuevo
      If rst.NoMatch Then 
      ' si no existe lo devuelvo y salgo del bucle
         AutoNumericoAleatorio = lngNuevo
         Exit Do
      End If ' si ya existe lo intento de nuevo
   Loop Until 0 = 1
Else ' si no hay registros genero aleatoriamente un valor dentro del rango indicado 
   AutoNumericoAleatorio = Int((lngMaximo - lngMinimo + 1) * Rnd + lngMinimo)
End If


AutoNumericoAleatorio_Salir:
   On Error Resume Next 
   ' cierro el recodset 
   If Not rst Is Nothing Then
       rst.Close
       Set rst = Nothing
   End If
   On Error GoTo 0
   Exit Function
   
AutoNumericoAleatorio_TratamientoErrores:
   MsgBox "Error " & Err.Number & " en proc.: AutoNumericoAleatorio de Módulo: Módulo1 (" & Err.description & ")", vbCritical + vbOKOnly, "ATENCION"
   Resume AutoNumericoAleatorio_Salir

End Function ' AutoNumericoAleatorio