Microsoft 365 Code fonction pour création code aléatoire

NONO14 · 27 Septembre 2024

Bonjour à toutes et à tous,
Comment à partir de cette fonction, créée par patricktoulon que je remercie au passage, peut-on placer les chiffres en premiers et les lettres à la suite, pour former par exemple 123abc. Ce code viendra s'ajouter au 3 premières lettres du Nom de la TextBox1 comme indiqué dans le 2ème code.
Il faut donc au final que le code ressemble à ça : (si le NOM est DUPONT) DUP123abc
La fonction CodeEmp fonctionne bien, mais mélange les lettres et les chiffres.
J'espère avoir été assez clair dans mes explications.

VB:

Function CodeEmp(Optional NbChar& = 0, Optional NbNum& = 0)
Dim Y&, C&, L

    If NbChar = 0 Then NbChar = 2 + (Round(Rnd * 6))
    If NbNum = 0 Then NbNum = 2 + (Round(Rnd * 3))
    
    Set Dico = CreateObject("Scripting.Dictionary")
    StrLettres = Split(StrConv("abcdefghijklmnopqrstuvwxyz", vbUnicode), Chr(0))
    StrChiffres = Split(StrConv("0123456789", vbUnicode), Chr(0))
    
    Do While Dico.Count < NbChar
        Y = Round(Rnd * UBound(StrLettres))
        Dico(StrLettres(Y)) = ""
    Loop
    
    Do While Dico.Count < NbChar + NbNum
        Y = Round(Rnd * UBound(StrChiffres))
        Dico(StrChiffres(Y)) = ""
    Loop
    
    L = Dico.Keys
    For C = 1 To 7
        y1 = Round(Rnd * UBound(L))
        y2 = Round(Rnd * UBound(L))
        yy = L(y1)
        L(y1) = L(y2): L(y2) = yy
    Next C
    
    CodeEmp = Join(L, "")
End Function

Code:

Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    With Me.TextBox3
        .Value = Left(Me.TextBox1, 3) & CodeEmp(3, 3)
        .SelStart = 100
    End With
        
    With Me.TextBox4
        .Value = CreatePassWord(5, 2)
        .SelStart = 100
    End With
End Sub

NONO14 · 6 Octobre 2024

Staple1600 à dit:
Re

@NONO14
[juste pour le fun]
Alors, pour ton cas, on peut transformer la formule en fonction personnalisée

VB:

Function cod() As String [IV1600].Formula2 = "=TEXTJOIN("""",1,INDEX(CHAR(VSTACK(SEQUENCE(26,1,65,1),SEQUENCE(10,1,48,1))),RANDARRAY(10,1,1,36,-1)))" cod = Range("IV1600").Value End Function Sub test() Randomize MsgBox cod End Sub

[/juste pour le fun]
PS: faire les adaptations nécessaires pour ton TextBox
Ici la macro test utilise simplement un MsgBox pour afficher les caractères

Bonjour Staple1600,
J'ai mis ton code en place et ça fonctionne bien, il réponds à mes attentes.
Par contre, je dois ajouter les deux derniers chiffes de l'année en cours, sachant que dans la feuille "Données" il y a une cellule nommée...

NONO14 · 27 Septembre 2024

La réponse m'a été apporté par Jean-Marie dans un autre post.

NONO14 · 27 Septembre 2024

Voici la solution apportée par Jean marie et que je remercie encore

VB:

Function CodeEmp(Optional NbChar& = 0, Optional NbNum& = 0) As String
    Dim Y&, DicoLettres As Object, DicoChiffres As Object
    Dim StrLettres() As String, StrChiffres() As String, CodeFinale As String

    ' Initialisation des valeurs par défaut si elles ne sont pas spécifiées
    If NbChar = 0 Then NbChar = 2 + (Round(Rnd * 6)) ' Nombre de lettres
    If NbNum = 0 Then NbNum = 2 + (Round(Rnd * 3))  ' Nombre de chiffres
    
    ' Création de deux dictionnaires distincts
    Set DicoLettres = CreateObject("Scripting.Dictionary")
    Set DicoChiffres = CreateObject("Scripting.Dictionary")

    ' Tableaux contenant les lettres et chiffres
    StrLettres = Split(StrConv("abcdefghijklmnopqrstuvwxyz", vbUnicode), Chr(0))
    StrChiffres = Split(StrConv("0123456789", vbUnicode), Chr(0))

    ' Remplir le dictionnaire avec les lettres
    Do While DicoLettres.Count < NbChar
        Y = Round(Rnd * UBound(StrLettres))
        DicoLettres(StrLettres(Y)) = ""
    Loop
    
    ' Remplir le dictionnaire avec les chiffres
    Do While DicoChiffres.Count < NbNum
        Y = Round(Rnd * UBound(StrChiffres))
        DicoChiffres(StrChiffres(Y)) = ""
    Loop
    
    ' Créer la chaîne finale : d'abord les chiffres, ensuite les lettres
    CodeFinale = Join(DicoChiffres.Keys, "") & Join(DicoLettres.Keys, "")
    
    ' Retourner le code généré
    CodeEmp = CodeFinale
End Function

patricktoulon · 29 Septembre 2024

RE
Bonjour
oui elle est vielle celle la
il te suffit de mettre la do while pour les num en premier
du coup je te donne la version 2022 qui en plus les maj les caractères spéciaux et le mélange optionnel

VB:

Sub test()
    MsgBox GenerateCode(5, 3) '5 lettres et 3 chiffres
    MsgBox GenerateCode(8, 3, 4) '8 lettres et 3 chiffres ,4 caractères spé
    MsgBox GenerateCode(3, 5, 2) '3 lettres 5 ch<iffres,3 caractères spé
    MsgBox GenerateCode(3, 5, 2, True) '3lettres 5 chiffres,2 caractères spé le tout mélangé
    MsgBox GenerateCode(3, 5, 4, True) '3lettres 5 chiffres,4 caractères spé le tout mélangé

End Sub
Function GenerateCode(Optional NbChar& = 0, Optional NbNum& = 0, Optional nbCharSpé As Long = 0, Optional Melange = False)
    Dim Y&, C&, L, X&, Temp, I&

    If NbChar = 0 Then NbChar = 2 + (Round(Rnd * 6))
    If NbNum = 0 Then NbNum = 2 + (Round(Rnd * 3))

    Set Dico = CreateObject("Scripting.Dictionary")
    StrLettres = Split(StrConv("abcdefghijklmnopqrstuvwxyzABCDEFG<HIJKLMNOPQRSTUVWXYZ", vbUnicode), Chr(0))
    StrChiffres = Split(StrConv("0123456789", vbUnicode), Chr(0))
    StrCharSpé = Split(StrConv("></-+;\#!:,?()", vbUnicode), Chr(0))

    Do While Dico.Count < NbNum
        Y = Round(Rnd * UBound(StrChiffres))
        Dico(StrChiffres(Y)) = ""
    Loop


    Do While Dico.Count < NbChar + NbNum
        Y = Round(Rnd * UBound(StrLettres))
        Dico(StrLettres(Y)) = ""
    Loop

    Do While Dico.Count < NbChar + NbNum + nbCharSpé
        Y = Round(Rnd * UBound(StrCharSpé))
        Dico(StrCharSpé(Y)) = ""
    Loop

    L = Dico.Keys
    Randomize
    If Melange Then
        For I = LBound(L) To UBound(L)
            X = Round(UBound(L) * Rnd)
            Temp = L(I): L(I) = L(X): L(X) = Temp
        Next
    End If

    GenerateCode = Join(L, "")
End Function

Staple1600 · 29 Septembre 2024

Bonjour le fil

Puisque que le fil indique en préfixe Microsoft 365, on peut simplement utiliser certaines nouvelles fonctions d'icelui.

Saisir cette formule dans une cellule
( appuyez sur F9 pour changer "aléatoirement" les caractères)

Enrichi (BBcode):

=JOINDRE.TEXTE("";1;INDEX(CAR(ASSEMB.V(SEQUENCE(26;1;65;1);SEQUENCE(10;1;48;1)));TABLEAU.ALEA(10;1;1;36;-1)))

Si vous voulez changer le nombre de caractère, changer la valeur du nombre rouge
(Ici la formule génère un mot de 10 caractères)

Si vous voulez des minuscules, remplacer 65 par 97

NONO14 · 29 Septembre 2024

patricktoulon à dit:

RE
Bonjour
oui elle est vielle celle la
il te suffit de mettre la do while pour les num en premier
du coup je te donne la version 2022 qui en plus les maj les caractères spéciaux et le mélange optionnel

VB:

Sub test()
    MsgBox GenerateCode(5, 3) '5 lettres et 3 chiffres
    MsgBox GenerateCode(8, 3, 4) '8 lettres et 3 chiffres ,4 caractères spé
    MsgBox GenerateCode(3, 5, 2) '3 lettres 5 ch<iffres,3 caractères spé
    MsgBox GenerateCode(3, 5, 2, True) '3lettres 5 chiffres,2 caractères spé le tout mélangé
    MsgBox GenerateCode(3, 5, 4, True) '3lettres 5 chiffres,4 caractères spé le tout mélangé

End Sub
Function GenerateCode(Optional NbChar& = 0, Optional NbNum& = 0, Optional nbCharSpé As Long = 0, Optional Melange = False)
    Dim Y&, C&, L, X&, Temp, I&

    If NbChar = 0 Then NbChar = 2 + (Round(Rnd * 6))
    If NbNum = 0 Then NbNum = 2 + (Round(Rnd * 3))

    Set Dico = CreateObject("Scripting.Dictionary")
    StrLettres = Split(StrConv("abcdefghijklmnopqrstuvwxyzABCDEFG<HIJKLMNOPQRSTUVWXYZ", vbUnicode), Chr(0))
    StrChiffres = Split(StrConv("0123456789", vbUnicode), Chr(0))
    StrCharSpé = Split(StrConv("></-+;\#!:,?()", vbUnicode), Chr(0))

    Do While Dico.Count < NbNum
        Y = Round(Rnd * UBound(StrChiffres))
        Dico(StrChiffres(Y)) = ""
    Loop


    Do While Dico.Count < NbChar + NbNum
        Y = Round(Rnd * UBound(StrLettres))
        Dico(StrLettres(Y)) = ""
    Loop

    Do While Dico.Count < NbChar + NbNum + nbCharSpé
        Y = Round(Rnd * UBound(StrCharSpé))
        Dico(StrCharSpé(Y)) = ""
    Loop

    L = Dico.Keys
    Randomize
    If Melange Then
        For I = LBound(L) To UBound(L)
            X = Round(UBound(L) * Rnd)
            Temp = L(I): L(I) = L(X): L(X) = Temp
        Next
    End If

    GenerateCode = Join(L, "")
End Function

Bonjour patricktoulon,
Merci beaucoup pour ta participation. Je vais tester ce code et je reviens pour vous dire ce qu'il en est.

NONO14 · 29 Septembre 2024

Staple1600 à dit:
Bonjour le fil

Puisque que le fil indique en préfixe Microsoft 365, on peut simplement utiliser certaines nouvelles fonctions d'icelui.

Saisir cette formule dans une cellule
( appuyez sur F9 pour changer "aléatoirement" les caractères)

Enrichi (BBcode):

=JOINDRE.TEXTE("";1;INDEX(CAR(ASSEMB.V(SEQUENCE(26;1;65;1);SEQUENCE(10;1;48;1)));TABLEAU.ALEA(10;1;1;36;-1)))

Si vous voulez changer le nombre de caractère, changer la valeur du nombre rouge
(Ici la formule génère un mot de 10 caractères)

Si vous voulez des minuscules, remplacer 65 par 97

Bonsoir Staple1600
Merci pour ta participation. Dans mon cas, le code s'affiche dans une TextBox lorsque l'on tabule sur une autre TextBox.

Staple1600 · 29 Septembre 2024

Re

@NONO14
[juste pour le fun]
Alors, pour ton cas, on peut transformer la formule en fonction personnalisée

VB:

Function cod() As String
[IV1600].Formula2 = "=TEXTJOIN("""",1,INDEX(CHAR(VSTACK(SEQUENCE(26,1,65,1),SEQUENCE(10,1,48,1))),RANDARRAY(10,1,1,36,-1)))"
cod = Range("IV1600").Value
End Function
Sub test()
Randomize
MsgBox cod
End Sub

[/juste pour le fun]
PS: faire les adaptations nécessaires pour ton TextBox
Ici la macro test utilise simplement un MsgBox pour afficher les caractères

NONO14 · 29 Septembre 2024

patricktoulon à dit:

RE
Bonjour
oui elle est vielle celle la
il te suffit de mettre la do while pour les num en premier
du coup je te donne la version 2022 qui en plus les maj les caractères spéciaux et le mélange optionnel

VB:

Sub test()
    MsgBox GenerateCode(5, 3) '5 lettres et 3 chiffres
    MsgBox GenerateCode(8, 3, 4) '8 lettres et 3 chiffres ,4 caractères spé
    MsgBox GenerateCode(3, 5, 2) '3 lettres 5 ch<iffres,3 caractères spé
    MsgBox GenerateCode(3, 5, 2, True) '3lettres 5 chiffres,2 caractères spé le tout mélangé
    MsgBox GenerateCode(3, 5, 4, True) '3lettres 5 chiffres,4 caractères spé le tout mélangé

End Sub
Function GenerateCode(Optional NbChar& = 0, Optional NbNum& = 0, Optional nbCharSpé As Long = 0, Optional Melange = False)
    Dim Y&, C&, L, X&, Temp, I&

    If NbChar = 0 Then NbChar = 2 + (Round(Rnd * 6))
    If NbNum = 0 Then NbNum = 2 + (Round(Rnd * 3))

    Set Dico = CreateObject("Scripting.Dictionary")
    StrLettres = Split(StrConv("abcdefghijklmnopqrstuvwxyzABCDEFG<HIJKLMNOPQRSTUVWXYZ", vbUnicode), Chr(0))
    StrChiffres = Split(StrConv("0123456789", vbUnicode), Chr(0))
    StrCharSpé = Split(StrConv("></-+;\#!:,?()", vbUnicode), Chr(0))

    Do While Dico.Count < NbNum
        Y = Round(Rnd * UBound(StrChiffres))
        Dico(StrChiffres(Y)) = ""
    Loop


    Do While Dico.Count < NbChar + NbNum
        Y = Round(Rnd * UBound(StrLettres))
        Dico(StrLettres(Y)) = ""
    Loop

    Do While Dico.Count < NbChar + NbNum + nbCharSpé
        Y = Round(Rnd * UBound(StrCharSpé))
        Dico(StrCharSpé(Y)) = ""
    Loop

    L = Dico.Keys
    Randomize
    If Melange Then
        For I = LBound(L) To UBound(L)
            X = Round(UBound(L) * Rnd)
            Temp = L(I): L(I) = L(X): L(X) = Temp
        Next
    End If

    GenerateCode = Join(L, "")
End Function

patricktoulon,
Merci beaucoup, ton code fonctionne très bien et réponds à mon attente.

NONO14 · 29 Septembre 2024

Staple1600 à dit:
Re

@NONO14
[juste pour le fun]
Alors, pour ton cas, on peut transformer la formule en fonction personnalisée

VB:

Function cod() As String [IV1600].Formula2 = "=TEXTJOIN("""",1,INDEX(CHAR(VSTACK(SEQUENCE(26,1,65,1),SEQUENCE(10,1,48,1))),RANDARRAY(10,1,1,36,-1)))" cod = Range("IV1600").Value End Function Sub test() Randomize MsgBox cod End Sub

[/juste pour le fun]
PS: faire les adaptations nécessaires pour ton TextBox
Ici la macro test utilise simplement un MsgBox pour afficher les caractères

Merci Staple1600, mais peut-on choisir le nombre de caractère qui sera affiché dans la TextBox ?

Staple1600 · 29 Septembre 2024

Re

@NONO14
Oui, comme expliqué dans le message#5

Staple1600 · 29 Septembre 2024

Re

@NONO14
Pour le fun again et avant de passer à l'apéro
Une version paramétrable

VB:

Sub test_2()
Randomize
xxx = cod(97)
MsgBox xxx
yyy = cod(, 12)
MsgBox yyy
End Sub
Private Function cod(Optional Casse = 65, Optional Nb_Car = 5) As String
[IV1600].Formula2 = "=TEXTJOIN("""",1,INDEX(CHAR(VSTACK(SEQUENCE(26,1," & Casse & ",1),SEQUENCE(10,1,48,1))),RANDARRAY(" & Nb_Car & ",1,1,36,-1)))"
cod = Range("IV1600").Value
End Function

NONO14 · 29 Septembre 2024

Staple1600 à dit:
Re

@NONO14
Oui, comme expliqué dans le message#5

D'accord, je n'avais pas compris

NONO14 · 29 Septembre 2024

Staple1600 à dit:

Re

@NONO14
Pour le fun again et avant de passer à l'apéro
Une version paramétrable

VB:

Sub test_2()
Randomize
xxx = cod(97)
MsgBox xxx
yyy = cod(, 12)
MsgBox yyy
End Sub
Private Function cod(Optional Casse = 65, Optional Nb_Car = 5) As String
[IV1600].Formula2 = "=TEXTJOIN("""",1,INDEX(CHAR(VSTACK(SEQUENCE(26,1," & Casse & ",1),SEQUENCE(10,1,48,1))),RANDARRAY(" & Nb_Car & ",1,1,36,-1)))"
cod = Range("IV1600").Value
End Function

Je vais tester ta version (certainement demain) et je reviens te dire ce qu'il en est.
Encore merci et bonne soirée à toutes et à tous

Staple1600 · 5 Octobre 2024

Bonjour le fil

@NONO14
Toujours pas reviendu
Tu as du zappé le résultat de ton test

PS: je ne suis point offusqué
J'aurais du être moins nébuleux et citer précisément la discussion idoine

NONO14 à dit:
Bonjour Staple1600,
De quel test parles-tu ? Pas sur ce problème. Il doit s'agir d'une autre discussion car j'ai testé beaucoup de version et je ne sais plus où j'en suis.
Toutes mes excuses si je t'ai offusqué, ce n'est pas mon intention.

Microsoft 365 Code fonction pour création code aléatoire

NONO14

XLDnaute Impliqué

NONO14

NONO14

XLDnaute Impliqué

NONO14

XLDnaute Impliqué

patricktoulon

XLDnaute Barbatruc

Staple1600

XLDnaute Barbatruc

NONO14

XLDnaute Impliqué

NONO14

XLDnaute Impliqué

Staple1600

XLDnaute Barbatruc

NONO14

XLDnaute Impliqué

NONO14

XLDnaute Impliqué

Staple1600

XLDnaute Barbatruc

Staple1600

XLDnaute Barbatruc

NONO14

XLDnaute Impliqué

NONO14

XLDnaute Impliqué

Staple1600

XLDnaute Barbatruc

Discussions similaires