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

N

NONO14

XLDnaute Occasionnel
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
 
Solution
N
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
Cliquez pour agrandir...
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...
Trier par date Trier par votes
N

NONO14

XLDnaute Occasionnel
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
 
Vote positif 0 Vote négatif
patricktoulon

patricktoulon

XLDnaute Barbatruc
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
 
Vote positif 0 Vote négatif
Staple1600

Staple1600

XLDnaute Barbatruc
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
 
Dernière édition:
Vote positif 0 Vote négatif
N

NONO14

XLDnaute Occasionnel
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
Cliquez pour agrandir...
Bonjour patricktoulon,
Merci beaucoup pour ta participation. Je vais tester ce code et je reviens pour vous dire ce qu'il en est.
 
Vote positif 0 Vote négatif
N

NONO14

XLDnaute Occasionnel
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
Cliquez pour agrandir...
Bonsoir Staple1600
Merci pour ta participation. Dans mon cas, le code s'affiche dans une TextBox lorsque l'on tabule sur une autre TextBox.
 
Vote positif 0 Vote négatif
Staple1600

Staple1600

XLDnaute Barbatruc
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
 
Vote positif 0 Vote négatif
N

NONO14

XLDnaute Occasionnel
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
Cliquez pour agrandir...
patricktoulon,
Merci beaucoup, ton code fonctionne très bien et réponds à mon attente.
 
Vote positif 0 Vote négatif
N

NONO14

XLDnaute Occasionnel
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
Cliquez pour agrandir...
Merci Staple1600, mais peut-on choisir le nombre de caractère qui sera affiché dans la TextBox ?
 
Vote positif 0 Vote négatif
Staple1600

Staple1600

XLDnaute Barbatruc
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
 
Vote positif 0 Vote négatif
N

NONO14

XLDnaute Occasionnel
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
Cliquez pour agrandir...
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
 
Vote positif 0 Vote négatif
Staple1600

Staple1600

XLDnaute Barbatruc
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.
Cliquez pour agrandir...
 
Vote positif 0 Vote négatif

Discussions similaires

R
  • Résolu(e)
XL 2016 Générateur mot de passe
Réponses
11
Affichages
652
Usine à gaz
Usine à gaz
Nicolas JACQUIN
  • Question
XL 2021 Exportation feuille msgbox yes no avec module Thisworkbook
2
Réponses
21
Affichages
770
Nicolas JACQUIN
Nicolas JACQUIN
S
  • Question
Modification d'un code VBA
Réponses
5
Affichages
1 K
Shpountz
S
JBARBE
  • Question
Un bon livre pour amélioration code VBA adressé à mapomme et autres personnes trés compétentes
Réponses
0
Affichages
1 K
JBARBE
JBARBE
T
  • Question
Optimisation d'un code VBA (Pour les courageux au grand coeur ^^)
2
Réponses
26
Affichages
4 K
TgR
T
J
  • Question
ce code est-il correct
Réponses
3
Affichages
2 K
Yaloo
Y
A
  • Question
Créer des tâches planifiers avec VBA et le planificateur Windows
Réponses
8
Affichages
10 K
tototiti2008
tototiti2008
G
  • Question
Probleme de code du a migration vers EXCEL 2007
2
Réponses
24
Affichages
4 K
JNP
JNP
G
  • Question
eurreur dans un code de filtration
Réponses
7
Affichages
2 K
geraldvc
G
Magic_Doctor
  • Question
Une sympathique fonction pour taper Prénom + Nom
Réponses
3
Affichages
2 K
Magic_Doctor
Magic_Doctor

Membres actuellement en ligne

3 membres et 58 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
314 121
Messages
2 106 128
Membres
109 495
dernier inscrit
jerome bonneau