Ocupar faltante en campo falso autonumérico

En un formulario tengo un campo llamado Solicitud que se genera secuencialmente en función de la fecha del sistema, indicando primero el año, después el mes, el día y por último el nº de registro de ese día, ejemplo "2021071603.

Lo que quiero es que si anulo un registro y doy de alta uno nuevo del mismo día ocupe el nº faltante que eliminé.

Tengo Evento después de actualizar del campo Fecha_alta.

Private Sub Fecha_alta_AfterUpdate()
Application.Echo False
If IsNull([Solicitud]) Then
Solicitud = Year([Fecha_alta]) & "" & Format(Month([Fecha_alta]), "00") & "" & Format(Day([Fecha_alta]), "00") & "" & Format((DCount("Fecha_alta", "Fichas", "Fecha_alta=forms!Fichas!Fecha_alta") + 1), "00")
End If
Forms!Fichas!Vales_de_pedido!Vale_de_pedido = Me.Solicitud
Forms!Fichas!Vales_de_pedido!Fecha_Peticion = Me.Fecha_alta
Form.Refresh

DoEvents

Application.Echo True
End Sub

2 respuestas

Respuesta
1

Sería necesario saber como eliminas el registro. Aunque todavía no tengo claro lo de rellenar el mismo día, mira, si tengo una tabla Tabla1 como

Creo una tabla llamada Eliminados sólo con un campo Solicitud(texto)

En el formulario, da igual único o continuo( lo pongo de esta forma que se ve mejor), relleno registros

Pulso el botón de eliminar el día 20 y me queda

Si ahora pongo la fecha de un registro nuevo con el mismo día del eliminado

Cuando pulso Enter

Me pone la solicitud eliminada. Ya te dije que no me ha quedado claro eso de repetir el mismo día.

Los códigos del botón y del evento Después de actualizar del cuadro de texto fechaalta son

Private Sub Comando7_Click()
DoCmd.SetWarnings False
DoCmd.RunSQL "insert into eliminados(solicitud)values(solicitud)"
DoCmd.RunSQL "delete * from tabla1 where idexpediente=" & Me.IdExpediente & ""
Me.Requery
End Sub
Private Sub FechaAlta_AfterUpdate()
If DCount("*", "eliminados") = 1 Then
Solicitud = DLookup("solicitud", "eliminados")
DoCmd.RunSQL "delete * from eliminados"
Else
If IsNull([Solicitud]) Then
Solicitud = Year(Date) & "" & Month(Date) & "" & Day(Date) & "" & Format(Nz(DCount("*", "tabla1")) + 1, "0000")
End If
End If
End Sub

Gracias Julián. Me funciona correctamente cuando elimino un registro y vuelvo a darlo de alta se le asigna la solicitud eliminada. Es lo que quería. Pero si elimino 2 registros del mismo día al dar de alta uno nuevo no me elige ninguno de los dos eliminados. Me coge uno duplicado. Se podría solucionar 

Es raro. Mira si tengo el formulario Tabla1

Voy a eliminar el del día 19. Al pulsar eliminar

Y me ha pasado el valor de Solicitud a la tabla Eliminados. Si ahora escribo, en un nuevo registro la fecha 19

Puedes ver que el cursor aún está en el control FechaAlta. Cuando pulso Enter( como la Solicitud está guardad en la tabla Eliminados, me la pone el el control Solicitud)

Y me deja la tabla Eliminados vacía para poder usarla nuevamente

Voy a eliminar ahora la del día 21

Y la vuelvo a dar de "alta". Puedes ver que el cursor está en Fecha Alta. Al pulsar Enter

Y el código es el que te puse

Private Sub Comando7_Click()
DoCmd.SetWarnings False
DoCmd.RunSQL "insert into eliminados(solicitud)values(solicitud)"
DoCmd.RunSQL "delete * from tabla1 where solicitud='" & Me.Solicitud & "'"
Me.Requery
End Sub
Private Sub FechaAlta_AfterUpdate()
If DCount("*", "eliminados") >= 1 Then
Solicitud = DLookup("solicitud", "eliminados")
Else
Solicitud = Year(Date) & "" & Month(Date) & "" & Day(Date) & "" & Format(Nz(DCount("*", "tabla1")) + 1, "0000")
End If
DoCmd.RunSQL "delete * from eliminados"
End Sub

Esto está pensado para eliminarlos uno por uno, como me pareció que preguntabas. En caso de querer eliminar dos, tres, etc de golpe, convendría añadirle a la tabla Eliminados otro campo fecha, para saber que fecha y solicitud se eliminaron, y así, al escribir un nuevo registro con esa fecha le asigne el valor que le corresponda.

También podrías obviar todos los botones y poner sólo un botón de eliminar en el formulario.

¡Gracias! 
Si si me funciona como tú dices y elimino desde un solo botón. Pero me refería a si por ejemplo tengo 5 registros del mismo día  y elimino el 2 y el 4. Al dar de alta uno nuevo de ese día ya no se genera el 2. Me repite uno existente. Pero nada si no puedo solucionar eso me vale perfectamente como tú ejemplo eliminando de 1 en 1

gracias

Respuesta
1

Espero que haya entendido de dar de alta uno con el mismo número, para mi es renumerar las solicitudes de la fecha. Tengo este ejemplo con 1 tabla 1 formulario y 1 módulo

TABLA

FORMULARIO

En el campo fechasol en el evento Después de actualizar tengo el siguiente código:

Private Sub fechasol_AfterUpdate()
 If Me.NewRecord Then
   Me.solicitud = sgtesol(Me.fechasol)
 End If
End Sub

Obtengo del número de la siguiente solicitud con la función sgtesol().

Public Function sgtesol(mfecha As Date) As String
  Dim strSQL As String
  Dim strAux As String
  Dim db As DAO.Database
  Dim rs As DAO.Recordset
  Dim aux As Integer
  strAux = Year(mfecha) & Format(Month(mfecha), "00") & Format(Day(mfecha), "00")
strSQL = "SELECT Count(tblsolicitud.solicitud) AS CANTIDAD FROM tblsolicitud " & vbCrLf
strSQL = strSQL & " HAVING Mid([solicitud],1,8)='" & strAux & "'"
Set db = CurrentDb
Set rs = db.OpenRecordset(strSQL)
If rs.RecordCount = 0 Then
  sgtesol = strAux & "01"
Else
   sgtesol = strAux & Format(rs!CANTIDAD + 1, "00")
End If
rs.Close
db.Close
Set rs = Nothing
Set db = Nothing
End Function

Ahora voy a retirar la solicitud número 2021072005 haciendo clic sobre el botón Retirar me preguntará con el siguiente mensaje.

Hago clic en y obtengo.

CÓDIGO DEL BOTÓN RETIRAR

Private Sub btnRetirar_Click()
 Dim temfecha As Date
 If MsgBox("¿Está seguro que retira la solicitud " & Me.solicitud & "?", vbQuestion + vbYesNo + vbDefaultButton2, "Retiro") = vbNo Then
   Exit Sub
 End If
 temfecha = Me.fechasol
 CurrentDb.Execute "DELETE FROM tblsolicitud WHERE ID=" & Me.ID
 Me.Requery
 If DCount("*", "tblsolicitud", "fechasol=" & Format(temfecha, "\#mm\/dd\/yyyy\#")) > 0 Then
   Call renumera(temfecha)
   Me.Requery
   DoCmd.GoToRecord , , acNewRec
 End If
End Sub

Este procedimiento llama la función renumera().

  Dim db As DAO.Database
  Dim rs As DAO.Recordset
  Dim faux As String
  Dim cuenta As Integer
  Dim aux As String
  faux = Format(mfecha, "\#mm\/dd\/yyyy\#")
  Set db = CurrentDb
  Set rs = db.OpenRecordset("SELECT * FROM tblsolicitud WHERE fechasol=" & faux & " ORDER BY ID")
  cuenta = 0
  rs.MoveFirst
  Do Until rs.EOF
      aux = Year(mfecha) & Format(Month(mfecha), "00") & Format(Day(mfecha), "00") + Format(cuenta + 1, "00")
      rs.Edit
      rs!solicitud = aux
      rs.Update
      cuenta = cuenta + 1
   rs.MoveNext
  Loop
End Function

Aunque utilicé funciones se podría haber hecho con procedimientos a nivel de formulario. En ejemplo considero el campo solicitud de tipo texto, si es numérico las funciones cambian.

Gracias Eduardo. ¿A la última función le falta el titulo?

Si que pena hace falta:

Public Function renumera(mfecha As Date)

Public Function renumera(mfecha As Date)
  Dim db As DAO.Database
  Dim rs As DAO.Recordset
  Dim faux As String
  Dim cuenta As Integer
  Dim aux As String
  faux = Format(mfecha, "\#mm\/dd\/yyyy\#")
  Set db = CurrentDb
  Set rs = db.OpenRecordset("SELECT * FROM tblsolicitud WHERE fechasol=" & faux & " ORDER BY ID")
  cuenta = 0
  rs.MoveFirst
  Do Until rs.EOF
      aux = Year(mfecha) & Format(Month(mfecha), "00") & Format(Day(mfecha), "00") + Format(cuenta + 1, "00")
      rs.Edit
      rs!solicitud = aux
      rs.Update
      cuenta = cuenta + 1
   rs.MoveNext
  Loop
End Function

¡Gracias! 
en el código de la función sgtesol() para llamar a la siguiente solicitud, mefecha es un campo de una tabla o es el nombre de un comando?  Es que después de actualizar el campo fechasol que en mi caso es fecha_alta no se añade nada en el campo solicitud. Algo no estoy haciendo bien

Sgtesol() requiere de un campo fecha tomado del formulario y sería lógicamente un campo de la tabla. Revise el ejemplo que le envíe.

Ya le envíe a su correo el link de descarga del ejemplo, la respuesta que le dan no hace lo usted necesita, olvídese de crear tablas.

¡Gracias! 

No termino de adaptar el código a mi ejemplo. Se lo he enviado por si pudiera revisarlo.

Gracias nuevamente

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas