Primero que todo disculpe la función que le envíe NO sirve está mal, en consecuencia la cambie totalmente y a la vez le cuento la respuesta que le dan no se ajusta a su pregunta porque su caso es de consecutivos por grupo y le respondieron es para seguimiento de una serie de números enteros.
FORMULARIO
Observe el formulario hago clic en "Adicionar" y obtengo la pregunta donde me solicitan ingresar el prefijo (Se podría obviar si tomara el año de la fecha actual). Ingreso el prefijo "2021"
Hago clic en Aceptar y obtengo
Me informa que falta o sigue el número de factura "202100004", efectivamente la que aparece resaltada en la primera imágen. Hago clic en Aceptar y me pregunta:
Hago clic en Sí y obtengo:
Observe que me aparece el número que faltaba para este prefijo (2021). Ahora si vuelo hacer clic en el botón Adicionar e ingreso nuevamente el prefijo "2021" obtengo:
Es la siguiente factura.
CÓDIGO DEL BOTON ADICIONAR
Private Sub btnFalta_Click()
Dim x As String
Dim strFalta As String
x = InputBox("Entre el valor del prefijo " & vbCrLf & vbCrLf & "Por ejemplo, 2022 ", "Prefijo")
If Len(x) > 0 Then
If Len(x) = 4 Then
strFalta = faltante(Val(x))
MsgBox "Falta o sigue el número de factura " & strFalta, vbInformation, "Le informo"
If MsgBox("¿Toma el número " & strFalta & " ?", vbQuestion + vbYesNo + vbDefaultButton2, "Adicionando número") = vbYes Then
DoCmd.RunSQL "INSERT INTO tblconsecutivos(idfactura) VALUES('" & strFalta & "')"
Me.Requery
Else
Exit Sub
End If
Else
MsgBox "Faltan dígitos al prefijo", vbCritical, "Cuidado..."
End If
End If
End Sub
CÓDIGO DE LA FUNCION FALTANTE()
Public Function faltante(mperiodo As Integer) As String
Dim strSQl As String
Dim rs As DAO.Recordset
Dim aux As String
Dim ant As Long
Dim sgte As Long
strSQl = "SELECT tblconsecutivos.idfactura" & vbCrLf
strSQl = strSQl & " FROM tblconsecutivos" & vbCrLf
strSQl = strSQl & " WHERE Mid([idfactura],1,4) =" & mperiodo & vbCrLf
strSQl = strSQl & " ORDER BY tblconsecutivos.idfactura;"
Set rs = CurrentDb.OpenRecordset(strSQl)
If rs.BOF And rs.EOF Then ' No hay registros
faltante = mperiodo & "00001"
Set rs = Nothing
Exit Function
End If
rs.MoveFirst
ant = rs!idfactura
Do Until rs.EOF
sgte = Val(rs!idfactura)
If sgte - ant > 1 Then
aux = ant + 1
Exit Do
End If
ant = Val(rs!idfactura)
rs.MoveNext
Loop
If Len(aux) > 0 Then
faltante = aux
Else
faltante = sgte + 1
End If
rs.Close
Set rs = Nothing
End Function
Debe cambiar el nombre de la tabla por el que corresponda en su base de datos. Si quiere el ejemplo lo puede solicitar a [email protected] favor anotar en el asunto la consulta.