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 · 5 Octobre 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

Me voilà revenu. Désolé d'avoir tardé à te répondre.
Je n'ai pas testé ton code car il a fallut restructuré mon application, mais je vais m'en servir car je dois revoir le code agent et ta proposition va beaucoup m'aider en ce sens.
Encore mille excuses pour le retard de près d'une semaine.

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 "Année" où se trouve l'année en cours. Ces chiffres doivent être en premier, ensuite les 3 premières lettres du Nom et ensuite ton code.
Voici le code dans mon formulaire et qui se rapporte à Txt_Nom.
Merci par avance pour ton aide

NONO14 · 6 Octobre 2024

NONO14 à dit:
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 "Année" où se trouve l'année en cours. Ces chiffres doivent être en premier, ensuite les 3 premières lettres du Nom et ensuite ton code.
Voici le code dans mon formulaire et qui se rapporte à Txt_Nom.
Merci par avance pour ton aide

J'ai trouvé la solution.
Voici le code

VB:

Private Sub Txt_Nom_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Dim CurrentYear As String
Application.ScreenUpdating = False

    CurrentYear = Right(Year(Date), 2)
    
    If Me.Txt_Code.Value <> "" Then Exit Sub
    
        With Me.Txt_Code
        .Value = CurrentYear & Left(Me.Txt_Nom, 3) & Cod
        End With
End Sub

Staple1600 · 6 Octobre 2024

Bonjour @NONO14

Bravo

J'allais poster cette variation de la fonction
(comme c'est fait, je poste)

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)))"
pref = Format(Date, "yy")
cod = pref & Range("IV1600").Value
End Function
Sub test()
Randomize
MsgBox cod
End Sub

Ton CurrentYear peut s'écrire comme je l'ai fait
CurrentYear=Format(Date, "yy")

NONO14 · 6 Octobre 2024

Staple1600 à dit:
Bonjour @NONO14

Bravo

J'allais poster cette variation de la fonction
(comme c'est fait, je poste)

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)))" pref = Format(Date, "yy") cod = pref & Range("IV1600").Value End Function Sub test() Randomize MsgBox cod End Sub

Ton CurrentYear peut s'écrire comme je l'ai fait
CurrentYear=Format(Date, "yy")

Bonjour Staple1600,
Merci pour ta réponse. Mais pour une fois que j'arrive à trouver tout seul, je vais garder mon code.
Cependant, je conserve ta proposition.

Staple1600 · 6 Octobre 2024

Re

@NONO14
je te disais simplement que tu pouvais simplifier
CurrentYear = Right(Year(Date), 2)
avec
CurrentYear=Format(Date, "yy")

Cela renvoie la même chose
(c'est plus simple et plus court)

TooFatBoy · 6 Octobre 2024

NONO14 à dit:
Right(Year(Date), 2)

Alors certes ça tombe en marche parce qu'Excel est sympa, mais normalement le premier argument d'un Right est une chaîne de caractères et non un nombre.

Quant au ScreenUpdating = False, il est inutile, voire contre-productif, de le mettre au début de chaque procédure.

NONO14 · 6 Octobre 2024

TooFatBoy à dit:
Alors certes ça tombe en marche parce qu'Excel est sympa, mais normalement le premier argument d'un Right est une chaîne de caractères et non un nombre.

Quant au ScreenUpdating = False, il est inutile, voire contre-productif, de le mettre au début de chaque procédure.

D'accord. Merci pour tes conseils

NONO14 · 6 Octobre 2024

Je reviens un instant sur cette discussion afin de demander une précision.
Si je ne souhaite que des chiffres dans ma combinaison, comment dois-je procéder ?
Merci par avance

NONO14 · 6 Octobre 2024

TooFatBoy à dit:
Alors certes ça tombe en marche parce qu'Excel est sympa, mais normalement le premier argument d'un Right est une chaîne de caractères et non un nombre.

Quant au ScreenUpdating = False, il est inutile, voire contre-productif, de le mettre au début de chaque procédure.

Hello !,
J'avais lu quelque part que désactivez l'actualisation de l'écran permettait d'accélérer l'exécution du code de la macro. On ne peut pas voir l'action de la macro, mais elle s'exécutera plus rapidement.

TooFatBoy · 6 Octobre 2024

NONO14 à dit:
J'avais lu quelque part que désactivez l'actualisation de l'écran permettait d'accélérer l'exécution du code de la macro. On ne peut pas voir l'action de la macro, mais elle s'exécutera plus rapidement.

C'est exact.

D'après ce que j'en sais :
- C'est inutile si tu n'écris pas dans une feuille.
- À la fin d'une macro le ScreenUpdating passerait automatiquement à True, donc ça pourrait désactiver le ScreenUpdating False de la macro appelante.

NONO14 · 6 Octobre 2024

TooFatBoy à dit:
C'est exact.

D'après ce que j'en sais :
- C'est inutile si tu n'écris pas dans une feuille.
- À la fin d'une macro le ScreenUpdating passerait automatiquement à True, donc ça pourrait désactiver le ScreenUpdating False de la macro appelante.

Ah d'accord, merci pour cette précision que je ne connaissais pas. Je vais me coucher moins bête ce soir.

Staple1600 · 6 Octobre 2024

NONO14 à dit:
Je reviens un instant sur cette discussion afin de demander une précision.
Si je ne souhaite que des chiffres dans ma combinaison, comment dois-je procéder ?
Merci par avance

@NONO14
Pour n'avoir que des chiffres, voir cette adaptation de ma précédente fonction

VB:

Sub test_3()
Randomize
xxx = cod
MsgBox xxx
yyy = cod(8)
MsgBox yyy
End Sub

Private Function cod(Optional Nb_Car = 5) As String
[IV1600].Formula2 = "=TEXTJOIN("""",1,CHAR(INDEX(SEQUENCE(10,1,48,1),RANDARRAY(" & Nb_Car & ",1,1,10,TRUE))))"
cod = Range("IV1600").Value
End Function

La fonction est paramétrable.
On peut choisir le nombre de caractère (par défaut c'est 5)

NONO14 · 6 Octobre 2024

Staple1600 à dit:
@NONO14
Pour n'avoir que des chiffres, voir cette adaptation de ma précédente fonction

VB:

Sub test_3() Randomize xxx = cod MsgBox xxx yyy = cod(8) MsgBox yyy End Sub Private Function cod(Optional Nb_Car = 5) As String [IV1600].Formula2 = "=TEXTJOIN("""",1,CHAR(INDEX(SEQUENCE(10,1,48,1),RANDARRAY(" & Nb_Car & ",1,1,10,TRUE))))" cod = Range("IV1600").Value End Function

La fonction est paramétrable.
On peut choisir le nombre de caractère (par défaut c'est 5)

Super, merci beaucoup et en plus ça fonctionne

Staple1600 · 6 Octobre 2024

Re

@NONO14

Super, merci beaucoup et en plus ça fonctionne

C'était déjà le cas, avec les diverses versions de la fonction cod que j'avais posté dans ce fil.
(qui était tombé dans tes oubliettes un certain lundi soir )

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

NONO14

XLDnaute Impliqué

NONO14

NONO14

XLDnaute Impliqué

NONO14

XLDnaute Impliqué

NONO14

XLDnaute Impliqué

Staple1600

XLDnaute Barbatruc

NONO14

XLDnaute Impliqué

Staple1600

XLDnaute Barbatruc

TooFatBoy

XLDnaute Barbatruc

NONO14

XLDnaute Impliqué

NONO14

XLDnaute Impliqué

NONO14

XLDnaute Impliqué

TooFatBoy

XLDnaute Barbatruc

NONO14

XLDnaute Impliqué

Staple1600

XLDnaute Barbatruc

NONO14

XLDnaute Impliqué

Staple1600

XLDnaute Barbatruc

Discussions similaires