Discussion :

[ladébrouille14]

Bonjour à tous! je suis nouveau ici, et j'ai besoin de votre aide. j'aimerais générer un code alphanumérique sur Access 2016, de type BA001. ce code doit s'incrémenter tout seul et apparaître sur un formulaire de saisie. j'aurais bien voulu simplifier avec le numéro auto, mais le bemol c'est que lorsqu'on supprime une saisie le numéro lui continu.

cordialement

[tee_grandbois]

Bonjour,
un exemple a été donné ici et, mis à part la partie formatage en hexadécimal, cela devrait convenir à ton besoin.

[titi95]

Bonjour

Je te propose une fonction que j'avais utilisée il y a ...
Elle permet d'incrémenter un numéro numériquement, alphabétiquement ou alpha-numériquement en fonction du CodeRech. Créer un simple champ Texte dans la table.
Par contre, si en tête du numéro tu veux des lettres fixes, il ne faut pas les traiter. Dans ce cas, tu ajoutes dans la table un champ calculé dans lequel tu concatènes ces lettres avec le champ contenant le numéro incrémenté.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
Function IncrementAlphaNum(NumActuel As String, CodeRech As String)
    'NumActuel : le récupérer dans la table avec un DMax sur le champ
    'CodeRech :
        'Pour chaque caractère, mettre 1 pour numérique, A pour alphabétique, Z pour alpha-numérique (chiffres avant lettres)
        'Exemple : "A111" pour 1er caractère alphabétque, numérique pour les 3 autres
        'En cas d'erreur, la fonction renvoie "Erreur" pour traitement (après mise au point, les MsgBox d'erreur peuvent être passées en commentaires)
 
    Dim NbC, PosC, Nb, Retenue, I As Integer
    Dim TypeRech, C  As String
    Retenue = 0
    Nb = 0
    NbC = Len(CodeRech)
    PosC = NbC
 
    If IsNull(NumActuel) Or NumActuel = "" Then
        For I = 1 To NbC
            TypeRech = Mid(CodeRech, I, 1)
            Select Case TypeRech
                Case "1"
                    NumActuel = NumActuel & "0"
                Case "A"
                    NumActuel = NumActuel & "A"
                Case "Z"
                    NumActuel = NumActuel & "0"
                Case Else
                    MsgBox "Le code n'est pas bon." & Chr(10) & "Il doit être exclusivement composé de 1, A ou Z.", vbCritical + vbOKOnly, "Code incompatible"
                    IncrementAlphaNum = "Erreur"
                    Exit Function
            End Select
        Next I
    End If
    If Len(NumActuel) <> NbC Then
        MsgBox "Le numéro actuel ne correspond pas au code.", vbCritical + vbOKOnly, "Incrémentation impossible"
        IncrementAlphaNum = "Erreur"
        Exit Function
    End If
    IncrementAlphaNum = NumActuel
 
Caractère:
    Nb = Nb + 1
    C = Mid(NumActuel, PosC, 1)
    TypeRech = Mid(CodeRech, PosC, 1)
    Select Case TypeRech
        Case "1"
            If Asc(C) < 48 Or Asc(C) > 57 Then
                MsgBox "Le numéro actuel ne correspond pas au code.", vbCritical + vbOKOnly, "Incrémentation impossible"
                IncrementAlphaNum = "Erreur"
                Exit Function
            End If
            If Asc(C) = 57 Then
                C = Chr(48)
                Retenue = 1
            Else
                C = Chr(Asc(C) + 1)
            End If
        Case "A"
            If Asc(C) < 65 Or Asc(C) > 90 Then
                MsgBox "Le numéro actuel ne correspond pas au code.", vbCritical + vbOKOnly, "Incrémentation impossible"
                IncrementAlphaNum = "Erreur"
                Exit Function
            End If
            If Asc(C) = 90 Then
                C = Chr(65)
                Retenue = 1
            Else
                C = Chr(Asc(C) + 1)
            End If
        Case "Z"
            If Asc(C) < 48 Or Asc(C) > 90 Or (Asc(C) > 57 And Asc(C) < 65) Then
                MsgBox "Le numéro actuel ne correspond pas au code.", vbCritical + vbOKOnly, "Incrémentation impossible"
                IncrementAlphaNum = "Erreur"
                Exit Function
            End If
            If Asc(C) = 57 Then
                C = Chr(65)
            Else
                If Asc(C) = 90 Then
                    C = Chr(48)
                    Retenue = 1
                Else
                    C = Chr(Asc(C) + 1)
                End If
            End If
    End Select
    IncrementAlphaNum = Left(IncrementAlphaNum, PosC - 1) & C & Right(IncrementAlphaNum, Len(IncrementAlphaNum) - PosC)
 
    If Retenue = 1 Then
        If Nb = NbC Then
            MsgBox "La série de numéros est complète.", vbCritical + vbOKOnly, "Incrémentation impossible"
            IncrementAlphaNum = "Erreur"
            Exit Function
        End If
        Retenue = 0
        PosC = PosC - 1
        GoTo Caractère
    End If
 
End Function

Titi95

[ladébrouille14]

merci j'ai vu la discussion, mais je ne me retrouve pas au niveau des noms des champs et tables

[ladébrouille14]

ok titi95, je vais voir ça

[titi95]

Bonsoir

je ne me retrouve pas au niveau des noms des champs et tables

Comme je t'ai proposé une fonction, tu n'as rien à modifier à l'intérieur de son code.
Il suffit de l'appeler par son nom et de renseigner ses 2 arguments. Exemple pour essayer avec une MsgBox qui affiche le résultat:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

MsgBox IncrementAlphaNum("000","A00")

Dans ton utilisation il suffira de remplacer l'argument NumActuel ("000" dans l'exemple) par la récupération du dernier numéro incrémenté attribué.
Pour le récupérer dans une table utilises :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

DMax("NomChamp", "NomTable")

Ne pas oublier de lire les commentaires en début de la fonction.

Titi95