[AC-2007] Génération d'un numéro automatique personnalisé [Résolu]

[MelaAllIn]

Bonjour à tous,

Je cherche a mettre en place un système de numérotation automatique personnalisé. J'ai trouvé de nombreux tuto sur le sujet, mais rien qui corresponde exactement à ce que je souhaite faire...

Voilà en détail ce que je voudrais faire :
J'ai un formulaire qui me permet de créer une nouvelle COMPANY. Dans ce formulaire, j'indique le nom de la COMPANY, ainsi qu'un numéro qui lui est propre (sur 6 chiffres), appelé ID. J'ai un bout de code sur l'évènement "Après MAJ" de l'ID qui me permet de vérifier que l'ID que je tente de créer n'existe pas déjà.
Jusque là, tout va bien.

Là où ça se complique, c'est que, dans certains cas, la COMPANY que je veux créer n'a pas d'ID. Dans ce cas, je voudrais pouvoir en générer un automatiquement, mais sur 3 chiffres uniquement (ou plutôt compris entre 1 et 999), en cliquant sur un bouton à côté du champ ID. Je sèche sur le petit bout de code à créer...

En espérant que quelqu'un pourra m'aider!
MelaAllIn

[marot_r]

Pour des raisons pratique je t'invite à avoir un numéroAuto qui identifie tes coomganie en plus du code que tu leur donne. Le code ci-dessous suppose cela.

Code :

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
private sub AttribuerNumero(prmNumAutoCompganie)
 
   on error goto Err_AttribuerNumero
 
   dim db as dao.database
   dim r as dao.recordset:set r=db.openRecordset("NomTaTable")
 
   dim numCompganie as long
 
CalculerNumero:
   numCompagnie=nz(dMax("idCompagny","[NomTaTable]","[IdCompagny]<1000",0)
   numCompagnie=numCompagnie+1
 
   if numCompagnie >= 1000 then
     error 5
   end if
 
   r.findfirst("[NumAutoCompagnie]=" & prmNumAutoCompganie)
 
   if r.nomatch then
     'Cas impossible normalement
     error 5
   end if
 
   r.edit
   r![IdCompagny]=numCompagnie
   r.update
 
   r.close:set r=nothing
   set db=nothing
 
Exit_AttribuerNumero:
   exit sub
 
Err_AttribuerNumero:
   select case err.number
 
      case ClefEnDouble 'Désolé j'ai oublié le numéro d'erreur correspondant
         'OK quelqu'un a déjà uiliser ce numéro, trouvons le prochain disponible
         resume CalculerNumero
 
      case else
         msgbox "Erreur : " & err.number & ", " & err.description, vbexclamation
 
   end select
 
   resume Exit_AttribuerNumero
end sub

A+

[MelaAllIn]

Bonjour à tous et merci à toi, marot_r pour ta réponse.
Par contre, je m'interroge sur la manière d'adapter ton code...
Dans l'intervalle, j'ai aussi pu avancer un peu sur le sujet.
Je vais donc essayer de décrire un peu mieux, peut-être, ce que j'ai fait jusqu'à présent :
- J'ai un formulaire de création d'une nouvelle Company, qui s'appelle F_COMPANY_NEW et qui est basé sur ma table COMPANY.
- Dans ce formulaire, j'ai mon champ CompanyARPID. Je peux donc saisir à la main l'ID dans ce champ, si je le connais (c'est alors un n° à 6 chiffres, qui est compris entre 140000 et 30000 environ) .
- Dans le cas où la COMPANY n'a pas d'ID, je veux pouvoir en générer un, compris entre 1 et 999, j'ai donc créé un bouton de génération d'ID, avec le code suivant :

Code :

1
2
3
4
5
6
7
Private Sub BNewID_Click()
 
Dim NewID As String
 
Me.CompanyARPID = Autonumber ("COMPANY", "CompanyARPID", NewID, 4)
 
End Sub

Le code de la fonction Autonumber est le suivant :

Code :

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
Function AutoNumber( _
  ByVal strTable As String, _
  ByVal strField As String, _
  Optional ByVal strFormat As String = "", _
  Optional ByVal intDigits As Integer = 4, _
  Optional ByVal dtDate As Date = #1/1/100#)
 
On Error GoTo AutoNumberErr
Dim varMarkers As Variant, varMark As Variant
Dim strCriteria As String
Dim strNum As String, lngNum As Long, strPart As String
 
If dtDate = #1/1/100# Then dtDate = Now()
strField = "[" & strField & "]"
strFormat = Replace(strFormat, "'", "''")
 
varMarkers = Array("YYYY", "YY", "Q", "MM", "WW", "DD")
For Each varMark In varMarkers
 
  strPart = Format(dtDate, varMark, vbMonday, vbFirstFourDays)
  strFormat = Replace(strFormat, "[" & varMark & "]", _
    Format(strPart, String(Len(varMark), "0")))
Next
 
strCriteria = strField & " LIKE '" & strFormat & "*'"
strNum = Nz(DMax(strField, strTable, strCriteria), "")
 
lngNum = IIf(strNum = "", 1, Val(Mid(strNum, Len(strFormat) + 1)) + 1)
strFormat = strFormat & Format(lngNum, String(intDigits, "0"))
 
AutoNumber = strFormat
Exit Function
 
AutoNumberErr:
  MsgBox "Erreur : " & Err.Description, vbCritical
  AutoNumber = ""
  Exit Function
 
End Function

Ce système fonctionne bien, sauf que lorsque que je veux générer un n° automatique, l'ID créé correspond à l'ID max +1 sur 6 chiffres, et ne prend donc pas en compte que les ID compris entre 1 et 999...

J'aimerais donc avoir votre aide pour savoir comment je peux améliorer le code sur le clic du bouton afin de ne prendre en compte que les ID compris entre 1 et 999, et pas tous les autres.

Je précise que, par ailleurs, je génère effectivement un NuméroAuto dans ma table COMPANY à chaque nouvel enregistrement, qui s'appelle CodeCompany.

Merci pour votre aide !

MelaAllIn

[marot_r]

Le problème avec ta fonction c'est que si 2 personnes crées une nouvelle société en même temps tu peux te retrouver avec 2 fois le même numéro au moment de l'enregistrement.

Mon code enregistre automatiquement le résultat calculé pour éviter cela.

Si ce n'est pas important pour toi tu peux simplement utiliser cela :

Code :

1
2
3
4
5
6
private function CalculerNumero() as long
   numCompagnie=nz(dMax("idCompagny","[NomTaTable]","[IdCompagny]<1000",0)
   numCompagnie=numCompagnie+1
 
   CalculerNumero=numCompganie
end function

dans ton code d'appel :

Code :

1
2
3
4
5
6
7
if isnull(me.[TonChamp]) then
     'Le code n'est pas renseigné, calculer un numéro temp
     Me.CompanyARPID=CalculerNumero()
   else
     'Le code est renseigné, calculer un numéro standard
     Me.CompanyARPID=AutoNumber( ... )
end if

A+

[MelaAllIn]

Merci marot_r pour ton aide.
J'ai utilisé le code que tu as proposé, et ça marche!
On crée très peu de nouvelles company, et il est donc quasiment impossible que l'on soit dans la cas d'une création simultanée d'un numéro!
Encore merci!
MelaAllIn