Soyez le premier à donner votre avis sur cette source.
Snippet vu 18 016 fois - Téléchargée 1 918 fois
'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
24 mai 2007 à 11:28
7 juin 2004 à 15:55
4L!@$
21 avril 2004 à 17:27
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.