Discussion :

[Dhumkazaar]

Bonjour,

Travaillant dans une reserve naturelle et étant chargé du développement de plusieurs bases de données en vue de leur exploitation sous SIG, j'aurais besoin de développer un système de numérotation automatique personnalisé du type :

XXX-0
XXX-1
XXX-2
XXX-3

Ou XXX = un ensemble de caractère fixe, il n'y aurait que le chiffre suivant qui évoluerait automatiquement....

Est ce que quelqu'un aurait une solution à mon problème ?

[sasmira_]

Bonjour,
Il faudra l'adapter à ton cas, mais voici ce que je propose:

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
 
Function AttribNumero(Champ As String, Table As String, Lettre As String, Optional FormatDuNb As Integer = 4) As String
'Attribution d'un numéro d'analyse de type alphanumérique:AAxx/yyyy
'où AA est un préfixe, xx l'année et yyyy le numéro d'analyse sur 4 chiffres
On Error GoTo Err_AttribNumero
   Dim Bds As DAO.Database
   Dim Rst As DAO.Recordset
   Dim PNo As Long
   Dim MaPos As Integer
   Dim FormatNb As String
   Dim PDeb As String
   Dim ValNum As String
   Dim i As Integer
   Set Bds = CurrentDb()
   Dim Lg As Integer
   Rq = "SELECT MAX(" & Champ & ") as ValMax FROM " & Table & " WHERE " & Champ & " Like '" & Lettre & "*' ;"
   Set Rst = Bds.OpenRecordset(Rq)
   If Not IsNull(Rst!ValMax) Then
      ValNum = Rst!ValMax
      If Len(ValNum) > 0 Then
         'Recherche de la barre de séparation:"/"
         MaPos = InStr(1, ValNum, "/", 1)
         If MaPos > 0 Then
            Lg = Len(ValNum) - MaPos
            PDeb = Left(ValNum, MaPos)
            PNo = Right(ValNum, Lg) + 1
         Else
            PDeb = ""
            PNo = CLng(ValNum) + 1
         End If
         For i = 1 To Lg
            FormatNb = FormatNb & "0"
         Next
         AttribNumero = PDeb & Format(CStr(PNo), FormatNb)
      End If
      Exit Function
   Else
      FormatNb = Format(FormatNb, "0000")
      PDeb = Right(CStr(Year(Date)), 2)
      AttribNumero = Lettre & PDeb & "/" & Format(1, FormatNb)
   End If
Exit_AttribNumero:
   Set Rst = Nothing
   Set Bds = Nothing
   Exit Function
Err_AttribNumero:
    MsgBox "Fct AttribNumero " & vbCrLf & Err.Description
    Resume Exit_AttribNumero
End Function

En espérant t'avoir aidé

[random]

Code :

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

1
2
3
4
5
 
 
SELECT Max("xxx-" & (CLng(Right([monchamp],Len([monchamp])-4))+1)) AS nclef
FROM matable
WHERE (((monchamp) Is Not Null));

[Dhumkazaar]

Bonjour,

Désolé de ne pas avoir repondu plus tot, mais j'ai passé les quelques jours précedant à decortiquer sans succès les codes que vous m'avez soumis... Je me dois de souligner que je débute en VBA et que je ne connait pas encore toutes les fonctions, meme si j'y vois plus clair aujourd'hui, et que je ne sais pas à quel évenement attacher ces codes....

[marot_r]

L'événement où il faut l'attacher est : Avant Insertion (BeforeInsert) au niveau du formulaire.

Attention avec le code ci-dessus, il ne fonctionne correctement QUE si tu es en monoutilisateur. En multi-utilisateur il peut entrainer le calcul de 2 fois le mëme numéro.

Donc il te faut ajouter du code pour gérer les doublons de numéro dans le form et rappeler le calcul tant que tu es en erreur.

Tu peux aussi ajouter le code ci-dessous, toujours dans l'evenement BeforeUpdate du form :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
 
    If EstRempli() Then
 
            If prmFormFacture.NewRecord Then
                Call CalculerNouveauNumDossier(prmFormFacture)
            End If
 
        Else
            'Aucun champ de saisi rempli, pas de création
            Cancel = True
    End If

EstRempli() est fonction qui vérifie que l'utilisateur a bien entré des données dans tous les champs de saisie, ça évite de perdre un numéro.

Remplace CalculerNouveauNumDossier par ta fonction de calcul.