Home‎ > ‎

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
SelectionFile type iconFile nameDescriptionSizeRevisionTimeUser
ċ

Descargar
Descarga el Ejemplo  41 kb v. 1 23 abr. 2010 17:22 Jefferson Jimenez
Comments