Sub A_COD(ByVal c As Long, Optional p As String)
' 21 Nivôse CCXVII
' ROGER2327 fecit.
Dim i As Long, j As Long, n As String, cal As Long, tf As Boolean
Dim dat()
Dim pt()
Application.ScreenUpdating = False
cal = Application.Calculation
Application.Calculation = xlCalculationManual
[COLOR="DarkOliveGreen"]' Interprétation du descripteur p[/COLOR]
If Len(p) = 0 Then ' modèle par défaut
pt = Array(8, Array(26, "ABCDEFGHIJKLMNOPQRSTUVWXYZ"), Array(26, "ABCDEFGHIJKLMNOPQRSTUVWXYZ"), Array(0, "-"), _
Array(10, "1234567890"), Array(10, "1234567890"), Array(0, "-"), Array(26, "ABCDEFGHIJKLMNOPQRSTUVWXYZ"), _
Array(26, "ABCDEFGHIJKLMNOPQRSTUVWXYZ"))
Else
ReDim pt(Len(p))
pt(0) = 0
j = 1
For i = 1 To Len(p)
n = Mid$(p, j, 1)
Select Case n
Case ""
Case "["
n = Mid$(p, j + 1, InStr(j, p, "]") - j - 1)
pt(i) = Array(0, n)
j = j + Len(n) + 2
pt(0) = 1 + pt(0)
Case Else
Select Case n
Case "0": pt(i) = Array(10, "1234567890"): pt(0) = 1 + pt(0): j = j + 1
Case "9": pt(i) = Array(9, "123456789"): pt(0) = 1 + pt(0): j = j + 1
Case "L": pt(i) = Array(26, "ABCDEFGHIJKLMNOPQRSTUVWXYZ"): pt(0) = 1 + pt(0): j = j + 1
Case "M": pt(i) = Array(24, "ABCDEFGHJKLMNPQRSTUVWXYZ"): pt(0) = 1 + pt(0): j = j + 1
Case "C": pt(i) = Array(20, "BCDFGHJKLMNPQRSTVWXZ"): pt(0) = 1 + pt(0): j = j + 1
Case "V": pt(i) = Array(6, "AEIOUY"): pt(0) = 1 + pt(0): j = j + 1
Case "W": pt(i) = Array(4, "AEUY"): pt(0) = 1 + pt(0): j = j + 1
Case Else: pt(i) = Array(0, Mid$(p, j, 1)): pt(0) = 1 + pt(0): j = j + 1
End Select
End Select
Next i
End If
ReDim Preserve pt(pt(0))
[COLOR="DarkOliveGreen"]' Fin de l'interprétation du descripteur p[/COLOR]
[COLOR="DarkOliveGreen"]' Engendrement des références[/COLOR]
dat = Cells(1, c).CurrentRegion.Value
For i = 2 To UBound(dat, 1)
If IsEmpty(dat(i, c)) Then
Do
n = ""
tf = False
For j = 1 To pt(0)
If pt(j)(0) Then
n = n & Mid$(pt(j)(1), Int(pt(j)(0) * Rnd() + 1), 1)
Else
n = n & pt(j)(1)
End If
Next j
For j = 2 To UBound(dat, 1): tf = tf Or (n = dat(j, c)): Next j
Loop While tf
dat(i, c) = n
Cells(i, c) = n
End If
Next i
[COLOR="DarkOliveGreen"]' Fin de l'engendrement des références[/COLOR]
Application.Calculation = cal
Application.ScreenUpdating = True
End Sub