XL 2016 Générateur mot de passe

ReneDav14000 · 7 Décembre 2022

Bonjour à tous,

J'ai trouvé ce code sur Internet qui permet de générer un mot de passe. Ce code est l'œuvre de patricktoulon que je remercie.
Ma question est la suivante :
Est-il possible grâce à ce code de générer un MP automatiquement lorsque l'utilisateur tape un NOM dans une TextBox ?
Par exemple : il tape LEGRAND dans la TextBox et après tabulation le MP de créé dans une autre TextBox sans qu'il ait besoin d'intervenir dans l'objet.
Merci par avance pour votre (j'ai un peu de temps avant mon départ).

VB:

'Code créé par patricktoulon

Private Sub CommandButton1_Click()
    Dim tablo, chaine As String, cpt As Long, dico As Object
    Dim strLettres, strChiffres, faire, lettre As String, chiffre As String, symb As String, ind As Long
    
    strLettres = Split(StrConv("abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ", vbUnicode), Chr(0))
    strChiffres = Split(StrConv("0123456789", vbUnicode), Chr(0))
  
    Randomize
    
    ReDim tablo(Val(NBMP), 2)
    Set dico = CreateObject("Scripting.Dictionary")
    
    Do    ' boucle general pour le nombre de mots de passe
        cpt = cpt + 1: chaine = "": faire = dico.RemoveAll()
        
        Do    'boucle pour les caracteres
            lettre = strLettres(Rnd * UBound(strLettres))
            If Not dico.exists(lettre) Then dico(lettre) = "": chaine = chaine & lettre
        Loop Until dico.Count = Val(NBCA)
        
        Do    'boucle pour les chiffres
            chiffre = strChiffres(Rnd * UBound(strChiffres))
            If Not dico.exists(chiffre) Then dico(chiffre) = "": chaine = chaine & chiffre
        Loop Until dico.Count = Val(NBCA) + Val(NBCH)
        
      
        faire = dico.RemoveAll()
        Do    ' boucle pour mettre en desordre les carateres
            ind = Round(Rnd * Len(chaine)): If ind = 0 Then ind = 1
            lettre = Mid(chaine, ind, 1)
            If Not dico.exists(lettre) Then dico(lettre) = "": tablo(cpt - 1, 0) = tablo(cpt - 1, 0) & lettre
        Loop Until dico.Count = Len(chaine)
        
        tablo(cpt - 1, 1) = Len(tablo(cpt - 1, 0)) & " caracteres "
    
    Loop Until cpt = Val(NBMP)
    ListBox1.ColumnCount = 2: ListBox1.List = tablo
End Sub

patricktoulon · 7 Décembre 2022

re
voici adapter et remastérisée en function

VB:

Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    With TextBox2
        'nombre de lettre au hasard (entre 6 et 12) ,nombre de chifre au hazard(entre 2 et 5)
        '.value = createpasword

        'ou
        '10 lettre ou symbole  au hasard et 4 chiffres au hasard
        .Value = createpasword(10, 4)
        .SelStart = 100
    End With
End Sub
Function createpasword(Optional nbchar& = 0, Optional nbNum& = 0)
Dim x&, i&, t

    If nbchar = 0 Then nbchar = 6 + (Round(Rnd * 6))
    If nbNum = 0 Then nbNum = 2 + (Round(Rnd * 3))

    Set dico = CreateObject("Scripting.Dictionary")
    strlettres =...

Deadpool_CC · 7 Décembre 2022

Bonjour,
@patricktoulon ... puisque t'es toujours actif ... je te laisse intervenir sur ton oeuvre

ReneDav14000 · 7 Décembre 2022

Voici un petit fichier pour expliquer mon souhait, si c'est réalisable. A l'approche de Noël on ne sait jamais.

patricktoulon · 7 Décembre 2022

re
voici adapter et remastérisée en function

VB:

Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    With TextBox2
        'nombre de lettre au hasard (entre 6 et 12) ,nombre de chifre au hazard(entre 2 et 5)
        '.value = createpasword

        'ou
        '10 lettre ou symbole  au hasard et 4 chiffres au hasard
        .Value = createpasword(10, 4)
        .SelStart = 100
    End With
End Sub
Function createpasword(Optional nbchar& = 0, Optional nbNum& = 0)
Dim x&, i&, t

    If nbchar = 0 Then nbchar = 6 + (Round(Rnd * 6))
    If nbNum = 0 Then nbNum = 2 + (Round(Rnd * 3))

    Set dico = CreateObject("Scripting.Dictionary")
    strlettres = Split(StrConv("abcdefg/hijklmnopqrst|uvwxyzABCD_EFGH?IJKLMN-OPQRS.TUVWXYZ", vbUnicode), Chr(0))
    strChiffres = Split(StrConv("0123456789", vbUnicode), Chr(0))


    'recupération des lettres au hazard(nombre de lettre =nbchar)
    Do While dico.Count < nbchar
        x = Round(Rnd * UBound(strlettres))
        dico(strlettres(x)) = ""
    Loop
    'recupération des chiffres au hazard(nombre de chiffre =nbnum)
    Do While dico.Count < nbchar + nbNum
        x = Round(Rnd * UBound(strChiffres))
        dico(strChiffres(x)) = ""
    Loop

    'mélange des caractères obtenus
    t = dico.keys
    For i = 1 To 10
        x1 = Round(Rnd * UBound(t))
        x2 = Round(Rnd * UBound(t))
        xx = t(x1)
        t(x1) = t(x2): t(x2) = xx
    Next
    createpasword = Join(t, "")
End Function

démo

ReneDav14000 · 7 Décembre 2022

Bonjour patrick,
Tu es le Père Noël c'est vraiment super. Merci du fond du cœur pour ton investissement.
Joyeuses fêtes à toutes et à tous et à très bientôt si tout se passe bien.

dysorthographie · 7 Décembre 2022

Bonjours tous,
Patrick sur la vidéo c'est toujours le même mot de passe

patricktoulon · 7 Décembre 2022

patricktoulon · 7 Décembre 2022

dysorthographie à dit:
Bonjours tous,
Patrick sur la vidéo c'est toujours le même mot de passe

c'est plus cher le mot de passe qui change a chaque fois
et je n'ai plus de pellicule

ReneDav14000 · 7 Décembre 2022

Le talent n'a pas de prix... C'est pour ça que je ne suis pas très bien payé.

patricktoulon · 7 Décembre 2022

il m'est arrivé certains mois de payer mes employés bien plus cher que moi
l'important c'est le chemin parcouru et faire bouffer les siens et laisser une trace
c'é ma fait le zeufie

Deadpool_CC · 8 Décembre 2022

Bonjour,
mais j'y pense la NSA a des plus gros ordinateurs que vous ... mettez "123456" ou "Azerty" comme mot de passe ... ce vous simplifiera la vie ... lol

ps : pour ceux qui n'ont pas d'humour, ne suivez pas ce conseil !

Usine à gaz · 8 Décembre 2022

Bjr, le fil, le Forum
Quand j'ai besoin de mots de passe, j'utilise le classeur joint

XL 2016 Générateur mot de passe

ReneDav14000

XLDnaute Occasionnel

patricktoulon

Deadpool_CC

XLDnaute Accro

ReneDav14000

XLDnaute Occasionnel

Pièces jointes

patricktoulon

XLDnaute Barbatruc

ReneDav14000

XLDnaute Occasionnel

dysorthographie

XLDnaute Accro

patricktoulon

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

ReneDav14000

XLDnaute Occasionnel

patricktoulon

XLDnaute Barbatruc

Deadpool_CC

XLDnaute Accro

Usine à gaz

XLDnaute Barbatruc

Pièces jointes

Discussions similaires