Générateur de login et de mot de passe, gestion des doublons et mise en forme des champs automatiques

Soyez le premier à donner votre avis sur cette source.

Snippet vu 17 211 fois - Téléchargée 1 915 fois

Contenu du snippet

Cette application access à été faite durant mon stage pour créer un login et mot de passe d'un utilisateur pour se connecter sur un poste. Ensuite les logins et mot de passe sont transférés sous excel et enregistrés en .txt pour pouvoir travailler le fichier txt et en faire un fichier .bat. Ainsi le fichier bat crée pour chaque utilisateur graçe à la moulinette le compte de l'utilisateur ainsi que ses droits automatiquement.
Donc j'ai enlevé les donnés concernant les élèves du lycée, et j'ai remplacé par la famille Simpson ainsi vous pourrez voir que le programme gère les doublons et remplace donc automatiquement les logins et mot de passe en double. Tout le code est détaillé pour que tout le monde comprenne. Vous avez juste à remplir le nom(NOM) et prénom(PRE) des personnes en laissant les champs login et mot de passe(MDP) vide puis à lancer la moulinette dans "Macro" Sinon, on peut lancer les macros de login et de mot de passe séparément. En espérant que cela pourra servir à quelqu'un.

Source / Exemple :


'Pour le module 1 qui génére le login et vérifie les doublons :

Function EnleverAccent(strTexte As String) As String
' Supprimer tous les accents d'une chaîne de caractères.
Dim Ctr As Integer 'permet de changer de caractère dans le mot
Dim strCaractère As String 'variable qui permet le remplacement des caractères spéciaux par des caractères normaux
Dim strResultat As String ' variable qui affiche le mot finale "nettoyé"
strResultat = "" 'on initialise le résultat à rien
For Ctr = 1 To Len(strTexte) 'Pour CTR : de 1 à la taille du texte(compteur)
   strCaractère = Mid(strTexte, Ctr, 1) 'on sélectionne le caractère défini dans le For précédent et on l'attribut à la variable strcaractère
   Select Case strCaractère 'on selectionne strCaractère
      Case "á", "à", "â", "ä", "ã" 'si il est egale à un des "a" spécials
         strCaractère = "a" 'on le remplace par un "a" normal
      Case "é", "è", "ê", "ë" 'si il est egale à un des "e" spécials
         strCaractère = "e" 'on le remplace par un e normal
      Case "í", "ì", "î", "ï" 'si il est egale à un des "i" spécials
         strCaractère = "i" 'on le remplace par un i normal
      Case "ó", "ò", "ô", "ö", "õ" 'si il est egale à un des "o" spécials
         strCaractère = "o" 'on le remplace par un o normal
      Case "ú", "ù", "û", "ü" 'si il est egale à un des "u" spécials
         strCaractère = "u" 'on le remplace par un u normal
      Case "ý", "ÿ" 'si il est egale à un des "y" spécials
         strCaractère = "y" 'on le remplace par un y normal
      Case "ç" 'si il est egale à un des "ç" spécials
         strCaractère = "c" 'on le remplace par un c normal
   End Select 'fin de selection
   strResultat = strResultat & strCaractère 'on modifie le mot avec le caractère qui vient d'être changé
Next Ctr 'on va au Ctr suivant(Ctr+1)
EnleverAccent = strResultat 'on attribue à la fonction le résultat final
End Function
Function remplacer(strlogin As String, strnom As String, strprenom As String) As String
'remplace le login en cas de doublon une 1ere fois(paramètres d'entré : login ; nom ; prenom)
Dim matable As Recordset 'on créé une table fictive qui contient les enregistrement de la table "eleves"
Dim noml As String * 5 'variable qui prend la valeur du nom de l'enregistrement en cours du formulaire si le nom de famille est >= à 5 caractères
Dim nomll As String * 4 'variable qui prend la valeur du nom de l'enregistrement en cours du formulaire si le nom de famille est = à 4 caractères
Dim nomlll As String * 3 'variable qui prend la valeur du nom de l'enregistrement en cours du formulaire si le nom de famille est = à 3 caractères
Dim nomllll As String * 2 'variable qui prend la valeur du nom de l'enregistrement en cours du formulaire si le nom de famille est = à 2 caractères
Dim prel As String * 1 'variable qui prend la première lettre du prénom de l'enregistrement en cours du formulaire
Dim compte As Integer 'compteur de caractères pour le nom

Set matable = CurrentDb.OpenRecordset("ELEVES") 'on attribue à la table les valeur de la table ELEVES

compte = Len(strnom) 'on attribue au compteur le nombre de caractère qu'à le nom pour savoir quelle variable utilisée

            If compte >= 5 Then 'si le compteur est >=5
            noml = strnom 'noml prend la valeur du nom dans l'enregistrement du formulaire
            noml = Replace(noml, " ", "_") 'on remplace les espaces contenus dans noml par "_"
            noml = Replace(noml, "'", "_") 'on remplace les "'" contenus dans noml par "_"
            noml = EnleverAccent(noml) 'on emploie la fonction EnleverAccent pour supprimer tous les caractères spéciaux
            noml = StrConv(noml, vbProperCase) 'On met noml au format : première lettre en majuscule, le reste en minuscule
            prel = strprenom 'prel prend la valeur du prénom dans l'enregistrement du formulaire et garde le premier caractère
            remplacer = noml & "2" & "_" & prel 'on attribue à la fonction remplacer la valeur du nouveau login généré
            End If
            
            If compte = 4 Then 'si le compteur est =4
            nomll = strnom 'nomll prend la valeur du nom dans l'enregistrement du formulaire
            nomll = Replace(nomll, " ", "_") 'on remplace les espaces contenus dans nomll par "_"
            nomll = Replace(nomll, "'", "_") 'on remplace les "'" contenus dans nomll par "_"
            nomll = EnleverAccent(nomll) 'on emploie la fonction EnleverAccent pour supprimer tous les caractères spéciaux
            nomll = StrConv(nomll, vbProperCase) 'On met nomll au format : première lettre en majuscule, le reste en minuscule
            prel = strprenom 'prel prend la valeur du prénom dans l'enregistrement du formulaire et garde le premier caractère
            remplacer = nomll & "2" & "_" & prel 'on attribue à la fonction remplacer la valeur du nouveau login généré
            End If
            
            If compte = 3 Then 'si le compteur est =3
            nomlll = strnom 'nomlll prend la valeur du nom dans l'enregistrement du formulaire
            nomlll = Replace(nomlll, " ", "_") 'on remplace les espaces contenus dans nomlll par "_"
            nomlll = Replace(nomlll, "'", "_") 'on remplace les "'" contenus dans nomll par "_"
            nomlll = EnleverAccent(nomlll) 'on emploie la fonction EnleverAccent pour supprimer tous les caractères spéciaux
            nomlll = StrConv(nomlll, vbProperCase) 'On met nomll au format : première lettre en majuscule, le reste en minuscule
            prel = strprenom 'prel prend la valeur du prénom dans l'enregistrement du formulaire et garde le premier caractère
            remplacer = nomlll & "2" & "_" & prel 'on attribue à la fonction remplacer la valeur du nouveau login généré
            End If
            
            If compte = 2 Then 'si le compteur est =4
            nomllll = strnom 'nomllll prend la valeur du nom dans l'enregistrement du formulaire
            nomllll = Replace(nomllll, " ", "_") 'on remplace les espaces contenus dans nomllll par "_"
            nomllll = Replace(nomllll, "'", "_") 'on remplace les "'" contenus dans nomll par "_"
            nomllll = EnleverAccent(nomllll) 'on emploie la fonction EnleverAccent pour supprimer tous les caractères spéciaux
            nomllll = StrConv(nomllll, vbProperCase) 'On met nomll au format : première lettre en majuscule, le reste en minuscule
            prel = strprenom 'prel prend la valeur du prénom dans l'enregistrement du formulaire et garde le premier caractère
            remplacer = nomllll & "2" & "_" & prel 'on attribue à la fonction remplacer la valeur du nouveau login généré
            End If

matable.Close 'on ferme la table en cours

End Function
Function remplacer2(strlogin As String, strnom As String, strprenom As String) As String
'remplace le login en cas de doublon une 2eme fois(paramètres d'entré : login ; nom ; prenom)
'idem que pour remplacer sauf qu'en cas de doublon il remplace 2 par 3 dans le login
Dim matable As Recordset
Dim noml As String * 5
Dim nomll As String * 4
Dim nomlll As String * 3
Dim nomllll As String * 2
Dim prel As String * 1
Dim compte As Integer

Set matable = CurrentDb.OpenRecordset("ELEVES")

compte = Len(strnom)

            If compte >= 5 Then
            noml = strnom
            noml = Replace(noml, " ", "_")
            noml = Replace(noml, "'", "_")
            noml = EnleverAccent(noml)
            noml = StrConv(noml, vbProperCase)
            prel = strprenom
            remplacer2 = noml & "3" & "_" & prel
            End If
            
            If compte = 4 Then
            nomll = strnom
            nomll = Replace(nomll, " ", "_")
            nomll = Replace(nomll, "'", "_")
            nomll = EnleverAccent(nomll)
            nomll = StrConv(nomll, vbProperCase)
            prel = strprenom
            remplacer2 = nomll & "3" & "_" & prel
            End If
            
            If compte = 3 Then
            nomlll = strnom
            nomlll = Replace(nomlll, " ", "_")
            nomlll = Replace(nomlll, "'", "_")
            nomlll = EnleverAccent(nomlll)
            nomlll = StrConv(nomlll, vbProperCase)
            prel = strprenom
            remplacer2 = nomlll & "3" & "_" & prel
            End If
            
            If compte = 2 Then
            nomllll = strnom
            nomllll = Replace(nomllll, " ", "_")
            nomllll = Replace(nomllll, "'", "_")
            nomllll = EnleverAccent(nomllll)
            nomllll = StrConv(nomllll, vbProperCase)
            prel = strprenom
            remplacer2 = nomllll & "3" & "_" & prel
            End If

matable.Close 'on ferme la table en cours

End Function
Function remplacer3(strlogin As String, strnom As String, strprenom As String) As String
'remplace le login en cas de doublon une 3eme fois(paramètres d'entré : login ; nom ; prenom)
'idem que pour remplacer sauf qu'en cas de doublon il remplace 3 par 4 dans le login
Dim matable As Recordset
Dim noml As String * 5
Dim nomll As String * 4
Dim nomlll As String * 3
Dim nomllll As String * 2
Dim prel As String * 1
Dim compte As Integer

Set matable = CurrentDb.OpenRecordset("ELEVES")

compte = Len(strnom)

            If compte >= 5 Then
            noml = strnom
            noml = Replace(noml, " ", "_")
            noml = Replace(noml, "'", "_")
            noml = EnleverAccent(noml)
            noml = StrConv(noml, vbProperCase)
            prel = strprenom
            remplacer3 = noml & "4" & "_" & prel
            End If
            
            If compte = 4 Then
            nomll = strnom
            nomll = Replace(nomll, " ", "_")
            nomll = Replace(nomll, "'", "_")
            nomll = EnleverAccent(nomll)
            nomll = StrConv(nomll, vbProperCase)
            prel = strprenom
            remplacer3 = nomll & "4" & "_" & prel
            End If
            
            If compte = 3 Then
            nomlll = strnom
            nomlll = Replace(nomlll, " ", "_")
            nomlll = Replace(nomlll, "'", "_")
            nomlll = EnleverAccent(nomlll)
            nomlll = StrConv(nomlll, vbProperCase)
            prel = strprenom
            remplacer3 = nomlll & "4" & "_" & prel
            End If
            
            If compte = 2 Then
            nomllll = strnom
            nomllll = Replace(nomllll, " ", "_")
            nomllll = Replace(nomllll, "'", "_")
            nomllll = EnleverAccent(nomllll)
            nomllll = StrConv(nomllll, vbProperCase)
            prel = strprenom
            remplacer3 = nomllll & "4" & "_" & prel
            End If

matable.Close 'on ferme la table en cours

End Function
Function remplacer4(strlogin As String, strnom As String, strprenom As String) As String
'remplace le login en cas de doublon une 4eme fois(paramètres d'entré : login ; nom ; prenom)
'idem que pour remplacer sauf qu'en cas de doublon il remplace 4 par 5 dans le login
Dim matable As Recordset
Dim noml As String * 5
Dim nomll As String * 4
Dim nomlll As String * 3
Dim nomllll As String * 2
Dim prel As String * 1
Dim compte As Integer

Set matable = CurrentDb.OpenRecordset("ELEVES")

compte = Len(strnom)

            If compte >= 5 Then
            noml = strnom
            noml = Replace(noml, " ", "_")
            noml = Replace(noml, "'", "_")
            noml = EnleverAccent(noml)
            noml = StrConv(noml, vbProperCase)
            prel = strprenom
            remplacer4 = noml & "5" & "_" & prel
            End If
            
            If compte = 4 Then
            nomll = strnom
            nomll = Replace(nomll, " ", "_")
            nomll = Replace(nomll, "'", "_")
            nomll = EnleverAccent(nomll)
            nomll = StrConv(nomll, vbProperCase)
            prel = strprenom
            remplacer4 = nomll & "5" & "_" & prel
            End If
            
            If compte = 3 Then
            nomlll = strnom
            nomlll = Replace(nomlll, " ", "_")
            nomlll = Replace(nomlll, "'", "_")
            nomlll = EnleverAccent(nomlll)
            nomlll = StrConv(nomlll, vbProperCase)
            prel = strprenom
            remplacer4 = nomlll & "5" & "_" & prel
            End If
            
            If compte = 2 Then
            nomllll = strnom
            nomllll = Replace(nomllll, " ", "_")
            nomllll = Replace(nomllll, "'", "_")
            nomllll = EnleverAccent(nomllll)
            nomllll = StrConv(nomllll, vbProperCase)
            prel = strprenom
            remplacer4 = nomllll & "5" & "_" & prel
            End If

matable.Close 'on ferme la table en cours

End Function
Function remplacer5(strlogin As String, strnom As String, strprenom As String) As String
'remplace le login en cas de doublon une 5eme fois(paramètres d'entré : login ; nom ; prenom)
'idem que pour remplacer sauf qu'en cas de doublon il remplace 5 par 6 dans le login
Dim matable As Recordset
Dim noml As String * 5
Dim nomll As String * 4
Dim nomlll As String * 3
Dim nomllll As String * 2
Dim prel As String * 1
Dim compte As Integer

Set matable = CurrentDb.OpenRecordset("ELEVES")

compte = Len(strnom)

            If compte >= 5 Then
            noml = strnom
            noml = Replace(noml, " ", "_")
            noml = Replace(noml, "'", "_")
            noml = EnleverAccent(noml)
            noml = StrConv(noml, vbProperCase)
            prel = strprenom
            remplacer5 = noml & "6" & "_" & prel
            End If
            
            If compte = 4 Then
            nomll = strnom
            nomll = Replace(nomll, " ", "_")
            nomll = Replace(nomll, "'", "_")
            nomll = EnleverAccent(nomll)
            nomll = StrConv(nomll, vbProperCase)
            prel = strprenom
            remplacer5 = nomll & "6" & "_" & prel
            End If
            
            If compte = 3 Then
            nomlll = strnom
            nomlll = Replace(nomlll, " ", "_")
            nomlll = Replace(nomlll, "'", "_")
            nomlll = EnleverAccent(nomlll)
            nomlll = StrConv(nomlll, vbProperCase)
            prel = strprenom
            remplacer5 = nomlll & "6" & "_" & prel
            End If
            
            If compte = 2 Then
            nomllll = strnom
            nomllll = Replace(nomllll, " ", "_")
            nomllll = Replace(nomllll, "'", "_")
            nomllll = EnleverAccent(nomllll)
            nomllll = StrConv(nomllll, vbProperCase)
            prel = strprenom
            remplacer5 = nomllll & "6" & "_" & prel
            End If

matable.Close 'on ferme la table en cours

End Function
Function remplacer6(strlogin As String, strnom As String, strprenom As String) As String
'remplace le login en cas de doublon une 6eme fois(paramètres d'entré : login ; nom ; prenom)
'idem que pour remplacer sauf qu'en cas de doublon il remplace 6 par 7 dans le login
Dim matable As Recordset
Dim noml As String * 5
Dim nomll As String * 4
Dim nomlll As String * 3
Dim nomllll As String * 2
Dim prel As String * 1
Dim compte As Integer

Set matable = CurrentDb.OpenRecordset("ELEVES")

compte = Len(strnom)

            If compte >= 5 Then
            noml = strnom
            noml = Replace(noml, " ", "_")
            noml = Replace(noml, "'", "_")
            noml = EnleverAccent(noml)
            noml = StrConv(noml, vbProperCase)
            prel = strprenom
            remplacer6 = noml & "7" & "_" & prel
            End If
            
            If compte = 4 Then
            nomll = strnom
            nomll = Replace(nomll, " ", "_")
            nomll = Replace(nomll, "'", "_")
            nomll = EnleverAccent(nomll)
            nomll = StrConv(nomll, vbProperCase)
            prel = strprenom
            remplacer6 = nomll & "7" & "_" & prel
            End If
            
            If compte = 3 Then
            nomlll = strnom
            nomlll = Replace(nomlll, " ", "_")
            nomlll = Replace(nomlll, "'", "_")
            nomlll = EnleverAccent(nomlll)
            nomlll = StrConv(nomlll, vbProperCase)
            prel = strprenom
            remplacer6 = nomlll & "7" & "_" & prel
            End If
            
            If compte = 2 Then
            nomllll = strnom
            nomllll = Replace(nomllll, " ", "_")
            nomllll = Replace(nomllll, "'", "_")
            nomllll = EnleverAccent(nomllll)
            nomllll = StrConv(nomllll, vbProperCase)
            prel = strprenom
            remplacer6 = nomllll & "7" & "_" & prel
            End If

matable.Close 'on ferme la table en cours

End Function
Function Principale()
'Fonction principale qui génère les logins en appellant les fonctions secondaires

Dim noml As String * 5 'variable qui prend la valeur du nom de l'enregistrement en cours du formulaire si le nom de famille est >= à 5 caractères
Dim nomll As String * 4 'variable qui prend la valeur du nom de l'enregistrement en cours du formulaire si le nom de famille est = à 4 caractères
Dim nomlll As String * 3 'variable qui prend la valeur du nom de l'enregistrement en cours du formulaire si le nom de famille est = à 3 caractères
Dim nomllll As String * 2 'variable qui prend la valeur du nom de l'enregistrement en cours du formulaire si le nom de famille est = à 2 caractères
Dim prel As String * 1 'variable qui prend la première lettre du prénom de l'enregistrement en cours du formulaire
Dim compte As Integer 'compteur de caractères pour le nom
Dim nomu As String 'variable qui contient le nom de la personne de l'enregistrement du formulaire en cours
Dim prenu As String 'variable qui contient le prénom de la personne de l'enregistrement du formulaire en cours

DoCmd.OpenForm "ELEVES" 'ouvre le formulaire'ouvre le formulaire ELEVES pour pouvoir procéder à chaque enregistrement du login

Do While Forms("eleves").NewRecord = False ' tant qu'on n'est pas sur un enregistrement à créer

On Error GoTo Suite 'en cas d'erreur on va à suite
nomu = Forms![ELEVES]![NOM] ' la variable prend la valeur du nom de la personne de l'enregistrement en cours dans le formulaire
prenu = Forms![ELEVES]![PRE] ' la variable prend la valeur du prénom de la personne de l'enregistrement en cours dans le formulaire

    If nomu = "" Or prenu = "" Then 'si le nom ou/et le prénom sont vide alors :
    Forms![ELEVES]![Login] = "" 'on ne met rien comme login
    End If
    
    If nomu <> "" And prenu <> "" Then 'si c'est le contraire et que les deux sont remplis alors
    compte = Len(nomu) 'on attribue au compteur le nombre de caractère qu'à le nom pour savoir quelle variable utilisée
    End If

            If compte >= 5 Then 'commentaire idem que pour la fonction remplacer
            noml = nomu
            noml = Replace(noml, " ", "_")
            noml = Replace(noml, "'", "_")
            noml = EnleverAccent(noml)
            noml = StrConv(noml, vbProperCase)
            prel = prenu
            Forms![ELEVES]![Login] = noml & "_" & prel  'login
            doublremp
            End If
 
            If compte = 4 Then 'commentaire idem que pour la fonction remplacer
            nomll = nomu
            nomll = Replace(nomll, " ", "_")
            nomll = Replace(nomll, "'", "_")
            nomll = EnleverAccent(nomll)
            nomll = StrConv(nomll, vbProperCase)
            prel = prenu
            Forms![ELEVES]![Login] = nomll & "_" & prel  'login
            doublremp
            End If

            If compte = 3 Then 'commentaire idem que pour la fonction remplacer
            nomlll = nomu
            nomlll = Replace(nomlll, " ", "_")
            nomlll = Replace(nomlll, "'", "_")
            nomlll = EnleverAccent(nomlll)
            nomlll = StrConv(nomlll, vbProperCase)
            prel = prenu
            Forms![ELEVES]![Login] = nomlll & "_" & prel  'login
            doublremp
            End If
                    
            If compte = 2 Then 'commentaire idem que pour la fonction remplacer
            nomllll = nomu
            nomllll = Replace(nomllll, " ", "_")
            nomllll = Replace(nomllll, "'", "_")
            nomllll = EnleverAccent(nomllll)
            nomllll = StrConv(nomllll, vbProperCase)
            prel = prenu
            Forms![ELEVES]![Login] = nomllll & "_" & prel  'login
            doublremp
            End If

DoCmd.GoToRecord , , acNext 'Va à l'enregistrement suivant

Loop 'Boucle qui revient au While de début

Suite: 'programme en cas d'erreur

DoCmd.Close acForm, "ELEVES" 'ferme le formulaire ELEVES

End Function
Function rech(strlogin As String) As Boolean
Dim matable As Recordset 'on créé une table fictive qui contient les enregistrement de la table "eleves"
Dim compt As Integer ' on créé un compteur qui compte le nombre de fois que se trouve le login
compt = 0 'on initialise le compteur à 0 pour qu'à chaque fois que la fonction est appelée le compteur soit nul

Set matable = CurrentDb.OpenRecordset("ELEVES") 'on attribue à la table les valeur de la table ELEVES

Do While matable.EOF = False 'tant que l'on est pas à la fin des enregistrements
If matable("login") = strlogin Then 'si le champ login est = au login qui est attribué à l'enregistrement en cours alors :
compt = compt + 1 'on ajoute 1 au compteur
    If compt >= 1 Then 'si le compteur est = à 1 alors :
    rech = True 'le login existe déjà et on retourne Vrai
    Else 'sinon
    rech = False 'le login n'existe pas et on retourne Faux
    End If
End If
matable.MoveNext 'on va à la ligne de la table suivante
Loop 'Boucle qui revient au While de début
matable.Close 'on ferme la table en fin de recherche

End Function
Function doublremp()
Dim nomu As String 'variable qui contient le nom de la personne de l'enregistrement du formulaire en cours
Dim prenu As String 'variable qui contient le prénom de la personne de l'enregistrement du formulaire en cours

nomu = Forms![ELEVES]![NOM] ' la variable prend la valeur du nom de la personne de l'enregistrement en cours dans le formulaire
prenu = Forms![ELEVES]![PRE] ' la variable prend la valeur du prénom de la personne de l'enregistrement en cours dans le formulaire

If rech(Forms![ELEVES]![Login]) = True Then  ' si fonction rech renvoie true c'est qu'il y a doublon du login alors
Forms![ELEVES]![Login] = remplacer(Forms![ELEVES]![Login], nomu, prenu) 'nouvel valeur du login grâce à la fonction remplacer qui rajoute 2 après le nom
    If rech(Forms![ELEVES]![Login]) = True Then ' si fonction rech renvoie true c'est qu'il y a doublon du login alors
    Forms![ELEVES]![Login] = remplacer2(Forms![ELEVES]![Login], nomu, prenu) 'nouvel valeur du login grâce à la fonction remplacer2 qui remplace 2 par 3 après le nom
        If rech(Forms![ELEVES]![Login]) = True Then ' si fonction rech renvoie true c'est qu'il y a doublon du login alors
        Forms![ELEVES]![Login] = remplacer3(Forms![ELEVES]![Login], nomu, prenu) 'nouvel valeur du login grâce à la fonction remplacer3 qui remplace 3 par 4 après le nom
            If rech(Forms![ELEVES]![Login]) = True Then ' si fonction rech renvoie true c'est qu'il y a doublon du login alors
            Forms![ELEVES]![Login] = remplacer4(Forms![ELEVES]![Login], nomu, prenu) 'nouvel valeur du login grâce à la fonction remplacer4 qui remplace 4 par 5 après le nom
                If rech(Forms![ELEVES]![Login]) = True Then ' si fonction rech renvoie true c'est qu'il y a doublon du login alors
                Forms![ELEVES]![Login] = remplacer5(Forms![ELEVES]![Login], nomu, prenu) 'nouvel valeur du login grâce à la fonction remplacer5 qui remplace 5 par 6 après le nom
                    If rech(Forms![ELEVES]![Login]) = True Then ' si fonction rech renvoie true c'est qu'il y a doublon du login alors
                    Forms![ELEVES]![Login] = remplacer6(Forms![ELEVES]![Login], nomu, prenu) 'nouvel valeur du login grâce à la fonction remplacer6 qui remplace 6 par 7 après le nom
                    End If
                End If
            End If
        End If
    End If
End If
End Function

'Pour le module 2 qui génère les mots de passe et vérifie aussi les doublons :

Function MDP() 'création du mot de passe

Dim PasswdGen As String * 9 'Contient le mot de passe générer
Dim syl1 As String * 2 'Contient la première syllabe
Dim syl2 As String * 2 'Contient la deuxième syllabe
Dim syl3 As String * 2 'Contient la troisième syllabe
Dim chi1 As String * 2 'Contient les 2 chiffres
Dim car As String * 1 'place le caractère spéciale
Dim place As String 'Différentes possibilitées de placement du caractère spéciale
Dim p As Integer 'sélection au hasard de la place que prendra le caractère spéciale

Randomize

place = "246"

p = Int((Len(place) * Rnd) + 1) 'numéro au hasard
syl1 = sylabe 'attribue à syl1 la valeur d'une syllabe (fonction sylabe)
syl2 = sylabe 'attribue à syl2 la valeur d'une syllabe (fonction sylabe)
syl3 = sylabe 'attribue à syl3 la valeur d'une syllabe (fonction sylabe)
chi1 = chiffre 'attribue à chi1 la valeur de 2 chiffres (fonction chiffre)
car = spec 'attribue à car la valeur d'un caractère spécial (fonction spec)

If p = 2 Then 'si p=2 alors je place le caractère spéciale après la 1ere syllabe
PasswdGen = syl1 & car & syl2 & syl3 & chi1
Else
If p = 4 Then 'si p=4 alors je place le caractère spéciale après la 2eme syllabe
PasswdGen = syl1 & syl2 & car & syl3 & chi1
Else 'sinon p=6 et alors je place le caractère spéciale a la derniere syllabe
PasswdGen = syl1 & syl2 & syl3 & car & chi1
End If
End If

MDP = PasswdGen 'attribue à la fonction MDP la valeur du password

End Function
Function sylabe() 'génére une syllabe
Dim voyelle As String 'voyelle possible pour la génération
Dim consonne As String 'consonne possible pour la génération
Dim v As Integer 'nombre au hasard qui indiquera la voyelle à sélectionner
Dim c As Integer 'nombre au hasard qui indiquera la consonne à sélectionner
Dim voy As String * 1 'variable qui contiendra la voyelle prise au hasard
Dim con As String * 1 'variable qui contiendra la consonne prise au hasard

voyelle = Forms![MDP]![voyelle] 'attribut à la variable les paramètres contenus dans le formulaire MDP
consonne = Forms![MDP]![consonne] 'attribut à la variable les paramètres contenus dans le formulaire MDP

Randomize
v = Int((Len(voyelle) * Rnd) + 1) ' numéro au hasard
c = Int((Len(consonne) * Rnd) + 1) ' numéro au hasard

voy = Mid(voyelle, v, 1) 'selectionne la voyelle en fonction du nombre tiré au hasard
con = Mid(consonne, c, 1) 'selectionne la voyelle en fonction du nombre tiré au hasard

sylabe = con & voy 'la fonction prend la valeur de la concatenation de la consonne générée et de la voyelle générée

End Function
Function chiffre() 'génère une suite de deux chiffres
Dim nbre As String 'suite de nombres qui serviront à la génération
Dim c As Integer 'nombre au hasard qui indiquera le 1er chiffre à sélectionner
Dim c2 As Integer 'nombre au hasard qui indiquera le 2eme chiffre à sélectionner
Dim chif As String * 1 'variable qui contiendra le 1er chiffre pris au hasard
Dim chif2 As String * 1 'variable qui contiendra le 2eme chiffre pris au hasard

nbre = Forms![MDP]![chiffres] 'attribut à la variable les paramètres contenus dans le formulaire MDP

Randomize
c = Int((Len(nbre) * Rnd) + 1) ' numéro au hasard
c2 = Int((Len(nbre) * Rnd) + 1) ' numéro au hasard

chif = Mid(nbre, c, 1) 'selectionne le 1er chiffre en fonction du nombre tiré au hasard
chif2 = Mid(nbre, c2, 1) 'selectionne le 2eme chiffre en fonction du nombre tiré au hasard

chiffre = chif & chif2 'la fonction prend la valeur de la concatenation des 2 chiffres générés

End Function
Function spec()
Dim caract As String 'suite des caractères spéciaux qui serviront à la génération
Dim c As Integer 'nombre au hasard qui indiquera le caractère spéciale à sélectionner

caract = Forms![MDP]![caract_spec] 'attribut à la variable les paramètres contenus dans le formulaire MDP

Randomize
c = Int((Len(caract) * Rnd) + 1) ' numéro au hasard

spec = Mid(caract, c, 1) 'la fonction prend la valeur du caractère spéciale généré

End Function
Function PrincipaleMDP()

Dim nomu As String 'variable qui contient le nom de la personne de l'enregistrement du formulaire en cours
Dim prenu As String 'variable qui contient le prénom de la personne de l'enregistrement du formulaire en cours

DoCmd.OpenForm "MDP" 'ouvre le formulaire MDP pour pouvoir procéder à chaque génération de mot de passe
DoCmd.OpenForm "ELEVES" 'ouvre le formulaire ELEVES pour pouvoir procéder à chaque enregistrement du mot de passe

Do While Forms("eleves").NewRecord = False ' tant qu'on n'est pas sur un enregistrement à créer

On Error GoTo Suite 'en cas d'erreur on va à suite
nomu = Forms![ELEVES]![NOM] ' la variable prend la valeur du nom de la personne de l'enregistrement en cours dans le formulaire
prenu = Forms![ELEVES]![PRE] ' la variable prend la valeur du prénom de la personne de l'enregistrement en cours dans le formulaire

    If nomu = "" Or prenu = "" Then 'si le nom ou/et le prénom sont vide alors :
    Forms![ELEVES]![MDP] = "" 'on ne met rien comme mot de passe
    End If
    
    If nomu <> "" And prenu <> "" Then 'si c'est le contraire et que les deux sont remplis alors
            Forms![ELEVES]![MDP] = MDP 'on enregistre le mot de passe généré avec la fonction MDP
            doublrempMDP 'on appelle la fonction doublremp(vérifie pas de doublon et sinon génère un nouveau mot de passe pour l'enregistrement)
            End If
 
DoCmd.GoToRecord , , acNext 'Va à l'enregistrement suivant

Loop 'Boucle qui revient au While de début

Suite: 'programme en cas d'erreur

DoCmd.Close acForm, "ELEVES" 'ferme le formulaire ELEVES
DoCmd.Close acForm, "MDP" 'ferme le formulaire MDP

End Function
Function rechMDP(motdepasse As String) As Boolean 'recherche si le mot de passe existe déjà
Dim matable As Recordset 'on créé une table fictive qui contient les enregistrement de la table "eleves"
Dim compt As Integer ' on créé un compteur qui compte le nombre de fois que se trouve le mot de passe
compt = 0 'on initialise le compteur à 0 pour qu'à chaque fois que la fonction est appelée le compteur soit nul

Set matable = CurrentDb.OpenRecordset("ELEVES") 'on attribue à la table les valeur de la table ELEVES

Do While matable.EOF = False 'tant que l'on est pas à la fin des enregistrements
If matable("MDP") = motdepasse Then 'si le champ MDP est = au mot de passe qui est attribué à l'enregistrement en cours alors :
compt = compt + 1 'on ajoute 1 au compteur
    If compt >= 1 Then 'si le compteur est = à 1 alors :
    rechMDP = True 'le mot de passe existe déjà et on retourne Vrai
    Else 'sinon
    rechMDP = False 'le mot de passe n'existe pas et on retourne Faux
    End If
End If
matable.MoveNext 'on va à la ligne de la table suivante
Loop 'Boucle qui revient au While de début
matable.Close 'on ferme la table en fin de recherche

End Function
Function doublrempMDP() 'remplace le mot de passe génére en cas de doublon
Dim nomu As String 'variable qui contient le nom de la personne de l'enregistrement du formulaire en cours
Dim prenu As String 'variable qui contient le prénom de la personne de l'enregistrement du formulaire en cours

Do While rechMDP(Forms![ELEVES]![MDP]) = True ' tant que la fonction rechMDP retourne la valeur True(càd que le mot de passe existe déjà):
Forms![ELEVES]![MDP] = MDP 'on attribue au mot de passe de l'enregistrement en cours du formulaire un nouveau mot de passe
Loop 'Boucle qui revient au While de début

End Function

'Pour le module 3 qui met dans un format correct le nom et le prénom :

Function nom_espace()
'Met le champ NOM et PRE(prénom) de la table ELEVES au format correct
DoCmd.OpenForm "ELEVES"

Do While Forms("eleves").NewRecord = False 'ouvre le formulaire'ouvre le formulaire ELEVES pour pouvoir procéder à chaque mise à jour du nom

On Error GoTo Suite 'en cas d'erreur on va à suite
Forms![ELEVES]![NOM] = Replace(Forms![ELEVES]![NOM], " ", "_") 'on remplace les espaces contenus dans NOM par "_"
Forms![ELEVES]![NOM] = EnleverAccent(Forms![ELEVES]![NOM]) 'on emploie la fonction EnleverAccent pour supprimer tous les caractères spéciaux du NOM
Forms![ELEVES]![NOM] = UCase(Forms![ELEVES]![NOM]) 'On met NOM au format : première lettre en majuscule, le reste en minuscule
Forms![ELEVES]![PRE] = EnleverAccent(Forms![ELEVES]![PRE]) 'on emploie la fonction EnleverAccent pour supprimer tous les caractères spéciaux du PRE
DoCmd.GoToRecord , , acNext 'Va à l'enregistrement suivant

Loop 'Boucle qui revient au While de début

Suite: 'programme en cas d'erreur

DoCmd.Close acForm, "ELEVES" 'ferme le formulaire ELEVES

End Function

Conclusion :


Vous pouvez me contacter pour toute question à salet.julien@wanadoo.fr
Ce site et le site www.info-3000.com/access sont très utile pour la programmation en VBA sous access, je vous les recommande et je les remercie pour leur aide.

A voir également

Ajouter un commentaire

Commentaires

lilniceevil
Messages postés
1
Date d'inscription
lundi 11 septembre 2006
Statut
Membre
Dernière intervention
24 mai 2007
-
ca marche po^^
alias666
Messages postés
308
Date d'inscription
mardi 1 juin 2004
Statut
Membre
Dernière intervention
23 mars 2010
-
Ca me parait court quand meme mdr! :D

4L!@$
BruNews
Messages postés
21054
Date d'inscription
jeudi 23 janvier 2003
Statut
Modérateur
Dernière intervention
7 novembre 2014
13 -
ADMIN INFO

Le zip semble invalide, prenez le code directement depuis cette page.

BruNews, Admin CS, MVP Visual C++

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.