Ver Mensaje Individual
  #1 (permalink)  
Antiguo 22/11/2006, 15:37
javsoft
 
Fecha de Ingreso: junio-2006
Mensajes: 126
Antigüedad: 17 años, 10 meses
Puntos: 0
Pregunta Numeracion Correlativa sin huecos

me gustaria pasar este codigo que esta en VBA, esto lo tengo en un proyecto ADP con conexion a SQL SERVER a pasarlo a PHP para implementarlo.

Esta Funcion hace lo siguiente:

genera numeros correlativos es decir numeros ordenados sin huecos

asi de esta manera

Numeracion sin huecos
0001 0002 0003 0004 0005 0006 0007 0008 0009

Numeracion con huecos
0001 XXXX 0003 0004 0005 0006 0007 0008 0009



Public Function Autonumerico(strTabla As String, strCampo As String) As String
' declaraciones
Dim rst As ADODB.Recordset
Dim strSQL As String
Dim lngAnterior As Long
' crear recordset
strSQL = "SELECT " & strCampo & " as Numero" & " FROM " & strTabla & " ORDER BY " & strCampo & " ASC"
Set rst = New ADODB.Recordset
rst.Open strSQL, CurrentProject.Connection, , , adCmdKnown
lngAnterior = "0001"
' busco el primer hueco libre
With rst
' si la tabla está vacía
If .EOF And .BOF Then
Autonumerico = "0001"
Exit Function
Else
' si el primer registro es distinto de 1
If Val(rst!Numero) > 1 Then
Autonumerico = "0001"
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(Val(rst!Numero)) 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 Val(rst!Numero)
' si el siguiente es correlativo
Case Is = lngAnterior + 1
lngAnterior = Val(rst!Numero)
.MoveNext
' si el siguiente está libre
Case Is > lngAnterior + 1
Autonumerico = Format(lngAnterior + 1, "0000")
Exit Do
Case Is = lngAnterior
' si es igual (primer caso)
lngAnterior = Val(rst!Numero)
.MoveNext
End Select ' rst(strCampo)

Loop While Not .EOF
' si hemos llegado al fin de la tabla y estaban todos ocupados
If .EOF Then Autonumerico = Format(lngAnterior + 1, "0000")
End With ' rst
' cierro recordsets y base de datos
rst.Close
Set rst = Nothing
End Function ' Autonumerico