Crear un AutoNumerico String (Texto)

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