Option Compare Database
'************************************************************
'& &*
'& : || : &*
'& || &*
'& || &*
'& || &*
'& . - || - . &*
'& ( || ) &*
'& ) ( || ) ( &*
'& / || \ &*
'& ( || ) &*
'& ` ` &*
'& ` ____ ' &*
'& &*
'& Jefferson Jimenez (JJJT) &*
'& Cabimas - Venezuela &*
'& Agosto - 2016 &*
'& &*
'& &*
'& &*
'& &*
'& &*
'************************************************************
Enum ceros
Dos = 2
Tres = 3
Cuatro = 4
Cinco = 5
Seis = 6
End Enum
Function AutoNumerico(Id As String, Tabla As String, Campofrm As Control, cerosDer As ceros) As Long
Dim Ult, Pri, Sec, Def As String
Ult = Mid(DLast("" & Id & "", "" & Tabla & ""), 5)
If ComparaYear(Id, Tabla, Campofrm) = 0 Then
Pri = Format(Date, "yy")
Sec = Format(Date, "mm")
Select Case cerosDer
Case 2: Def = Format(1, "00")
Case 3: Def = Format(1, "000")
Case 4: Def = Format(1, "0000")
Case 5: Def = Format(1, "00000")
Case 6: Def = Format(1, "000000")
End Select
AutoNumerico = Pri & Sec & Def
Else
Pri = Left(DLast("" & Id & "", "" & Tabla & ""), 2)
If ComparaMes(Id, Tabla, Campofrm) = 0 Then
Sec = Format(Date, "mm")
Select Case cerosDer
Case 2: Def = Format(1, "00")
Case 3: Def = Format(1, "000")
Case 4: Def = Format(1, "0000")
Case 5: Def = Format(1, "00000")
Case 6: Def = Format(1, "000000")
End Select
AutoNumerico = Pri & Sec & Def
Else
Pri = Left(DLast("" & Id & "", "" & Tabla & ""), 2)
Sec = Mid(DLast("" & Id & "", "" & Tabla & ""), 3, 2)
Select Case cerosDer
Case 2: Def = Format(Ult + 1, "00")
Case 3: Def = Format(Ult + 1, "000")
Case 4: Def = Format(Ult + 1, "0000")
Case 5: Def = Format(Ult + 1, "00000")
Case 6: Def = Format(Ult + 1, "000000")
End Select
AutoNumerico = Pri & Sec & Def
End If
End If
End Function
Private Function ComparaMes(Id As String, Tabla As String, Campofrm As Control) As Integer
Dim db As DAO.Database
Dim rs As DAO.Recordset
Set db = CurrentDb()
Set rs = db.OpenRecordset(Tabla)
Do While Not rs.EOF()
If Mid(rs(Id), 3, 2) = Format(Date, "mm") Then
ComparaMes = ComparaMes + 1
End If
rs.MoveNext
Loop
rs.Close
Set rs = Nothing
Set db = Nothing
End Function
Private Function ComparaYear(Id As String, Tabla As String, Campofrm As Control) As Integer
Dim db As DAO.Database
Dim rs As DAO.Recordset
Set db = CurrentDb()
Set rs = db.OpenRecordset(Tabla)
Do While Not rs.EOF()
If Left(rs(Id), 2) = Format(Date, "yy") Then
ComparaYear = ComparaYear + 1
End If
rs.MoveNext
Loop
rs.Close
Set rs = Nothing
Set db = Nothing
End Function