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 576 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.
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.
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
- Générateur de nom de famille
- Générateur de syllabes - Meilleures réponses
- Generateur nom de famille - Meilleures réponses
- Generateur de nom entreprise - Guide
- Genere un nom au hazard - Codes sources - ASM (c et asm)
- PHP : Phpmudnames - générateur de noms - CodeS SourceS - Guide
- Visual Basic / VB.NET : Générer un nom de fichier temporaire unique - CodeS SourceS - Guide
- Delphi / Pascal : Générer un nom de fichier temporaire unique - CodeS SourceS - Guide
4L!@$
- Messages postés
-
21042
- Date d'inscription
- jeudi 23 janvier 2003
- Statut
- Modérateur
- Dernière intervention
- 21 août 2019
29Le 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.