Aveces nos preguntamos como crear un AutoNumerico tipo Texto(String)
Ademas que este se ejecute con caracteres, letras y numeros... Ejemplo:
A2010-Fct00001
A2010-Fct00002
A2010-Fct00003
y que cuando iniciemos un nuevo año sea :
A2011-Fct00004
A2011-Fct00005
A2011-Fct00006
El Codigo
Option Compare Database
Option Explicit
'Codigo VBA para crear Autonumerico String o Texto
'Almacenando caracteres, letras y numeros
Public PC$, SC$, TC$, CC$, QC$, DigitoAño$, DCodigo$, SepaRator$, _
StrDigitos$, StrElAño$, StrElAñoStr$, StrNomenStr$, _
ArAñoDer$, ArAñoIzq$, FDgt$, Separador$, Derecha$, _
Izquierda$, AutDerecha$, AutIzquierda$, Usere$, NumAsig$
'***************************************************************
'& &*
'& &*
'& &*
'& &*
'& Jefferson Jimenez (JJJT) &*
'& Cabimas - Venezuela &*
'& Abril - 2010 &*
'& &*
'& &*
'& &*
'& &*
'& &*
'***************************************************************
Sub AutoNumeStringJJJT(elID As String, Tabla As String, Campofrm As Control)
If DCount("*", "" & Tabla & "") > 0 Then
Campofrm.Value = JJJT_AutString(DLast("" & elID & "", "" & Tabla & ""))
Else
Campofrm.Value = DCodigo
End If
End Sub
Function JJJT_AutString(Ctl As String) As String
On Error GoTo Err_DesglAutString
Separador = InStr(Ctl, " ") Or _
InStr(Ctl, ".") Or _
InStr(Ctl, "/") Or _
InStr(Ctl, "-") Or _
InStr(Ctl, "\")
Select Case Mid(Ctl, Separador, 1)
Case " "
SepaRator = " "
Case "."
SepaRator = "."
Case "/"
SepaRator = "/"
Case "-"
SepaRator = "-"
Case "\"
SepaRator = "\"
End Select
Derecha = Right((Ctl), Len(Ctl) - InStrRev(Ctl, SepaRator))
Izquierda = User(Ctl)
If Left(Right((Ctl), Len(Ctl) - InStrRev(Ctl, SepaRator)), 1) = "A" Or _
Left(Right((Ctl), Len(Ctl) - InStrRev(Ctl, SepaRator)), 1) = "#" Or _
Left(Right((Ctl), Len(Ctl) - InStrRev(Ctl, SepaRator)), 1) = "Y" Then
If InStr(Derecha, "A") Then
StrElAñoStr = "A"
End If
If InStr(Derecha, "Año") Then
StrElAñoStr = "Año"
End If
If InStr(Derecha, "#") Then
StrElAñoStr = "#"
End If
If InStr(Derecha, "Yr") Then
StrElAñoStr = "Yr"
End If
StrElAño = Right(Derecha, Len(Derecha) - Len(StrElAñoStr))
If StrElAño Like "####" Then
DigitoAño = "##"
End If
If StrElAño Like "##" Then
End If
ArAñoDer = StrElAñoStr & StrElAño
Else
If InStr(Izquierda, "A") Then
StrElAñoStr = "A"
End If
If InStr(Izquierda, "Año") Then
StrElAñoStr = "Año"
End If
If InStr(Izquierda, "#") Then
StrElAñoStr = "#"
End If
If InStr(Izquierda, "Yr") Then
StrElAñoStr = "Yr"
End If
StrElAño = Right(Izquierda, Len(Izquierda) - Len(StrElAñoStr))
If StrElAño Like "####" Then
End If
If StrElAño Like "##" Then
End If
ArAñoIzq = StrElAñoStr & StrElAño
End If
AutDerecha = Right((Ctl), Len(Ctl) - InStrRev(Ctl, SepaRator))
AutIzquierda = User(Ctl)
If Left(Right((Ctl), Len(Ctl) - InStrRev(Ctl, SepaRator)), 1) = "F" Or _
Left(Right((Ctl), Len(Ctl) - InStrRev(Ctl, SepaRator)), 1) = "P" Or _
Left(Right((Ctl), Len(Ctl) - InStrRev(Ctl, SepaRator)), 1) = "C" Then
If InStr(AutDerecha, "Ft") Then
StrNomenStr = "Ft"
End If
If InStr(AutDerecha, "Fct") Then
StrNomenStr = "Fct"
End If
If InStr(AutDerecha, "Pd") Then
StrNomenStr = "Pd"
End If
If InStr(AutDerecha, "Ped") Then
StrNomenStr = "Ped"
End If
If InStr(AutDerecha, "Cp") Then
StrNomenStr = "Cp"
End If
If InStr(AutDerecha, "Cmpra") Then
StrNomenStr = "Cmpra"
End If
StrDigitos = Right(AutDerecha, Len(AutDerecha) - Len(StrNomenStr))
If StrDigitos Like "######" Then
FDgt = "000000"
End If
If StrDigitos Like "#####" Then
FDgt = "00000"
End If
If StrDigitos Like "####" Then
FDgt = "0000"
End If
If StrDigitos Like "###" Then
FDgt = "000"
End If
If StrDigitos Like "##" Then
FDgt = "00"
End If
If StrDigitos Like "#" Then
FDgt = "0"
End If
Else
If InStr(AutIzquierda, "Ft") Then
StrNomenStr = "Ft"
End If
If InStr(AutIzquierda, "Fct") Then
StrNomenStr = "Fct"
End If
If InStr(AutIzquierda, "Pd") Then
StrNomenStr = "Pd"
End If
If InStr(AutIzquierda, "Ped") Then
StrNomenStr = "Ped"
End If
If InStr(AutIzquierda, "Cp") Then
StrNomenStr = "Cp"
End If
If InStr(AutIzquierda, "Cmpra") Then
StrNomenStr = "Cmpra"
End If
StrDigitos = Right(AutIzquierda, Len(AutIzquierda) - Len(StrNomenStr))
If StrDigitos Like "######" Then
FDgt = "000000"
End If
If StrDigitos Like "#####" Then
FDgt = "00000"
End If
If StrDigitos Like "####" Then
FDgt = "0000"
End If
If StrDigitos Like "###" Then
FDgt = "000"
End If
If StrDigitos Like "##" Then
FDgt = "00"
End If
If StrDigitos Like "#" Then
FDgt = "0"
End If
End If
JJJT_AutString = AutoNumerico
Exit_DesglAutString:
Exit Function
Err_DesglAutString:
MsgBox Err.Description, vbCritical, "Error N°: " & Err.Number
Resume Exit_DesglAutString
End Function
Public Function User(StrCtl As String) As String
Usere = Right(StrCtl, Len(StrCtl) - InStrRev(StrCtl, SepaRator) + 1)
If Left(Usere, 1) = SepaRator Then
User = Left(StrCtl, InStrRev(StrCtl, SepaRator) - 1)
Else
User = StrCtl
End If
End Function
Public Function AutoNumerico() As String
NumAsig = StrDigitos + 1
If ArAñoDer <> "" Then
If StrElAño = Format(Date, "yyyy") Or _
StrElAño = Format(Date, "yy") Then
AutoNumerico = StrNomenStr & Format(NumAsig, FDgt) & SepaRator & ArAñoDer
Else
AutoNumerico = StrNomenStr & Format(NumAsig, FDgt) & SepaRator & StrElAñoStr & (StrElAño + 1)
End If
Else
If StrElAño = Format(Date, "yyyy") Or _
StrElAño = Format(Date, "yy") Then
AutoNumerico = ArAñoIzq & SepaRator & StrNomenStr & Format(NumAsig, FDgt)
Else
AutoNumerico = StrElAñoStr & (StrElAño + 1) & SepaRator & StrNomenStr & Format(NumAsig, FDgt)
End If
End If
End Function
Sub LimpiaVar()
PC = ""
SC = ""
TC = ""
CC = ""
QC = ""
DCodigo = ""
SepaRator = ""
StrDigitos = ""
StrElAño = ""
StrElAñoStr = ""
StrNomenStr = ""
ArAñoDer = ""
ArAñoIzq = ""
FDgt = ""
Separador = ""
Derecha = ""
Izquierda = ""
AutDerecha = ""
AutIzquierda = ""
Usere = ""
NumAsig = ""
End Sub