MOT DE PASSE - FICHIER MULTI UTILISATEUR

Sur le présent blog, je vous ai montré comment activer un MOT DE PASSE  fiable sur votre fichier Excel.

Sur cette page, je vais vous décrire comment donner l'accès à un fichier Excel utilisable par plusieurs utilisateurs (Nombre illimité) mais avec des tâches bien définies tel que :
a) Administrateur
b) Trésorier
c) utilisateur 1
d) utilisateur 2
et etc.

MISE EN FORME DU FICHIER 

Créez un fichier Excel avec quatre feuilles différents que vous nommez :
1) ACCUEIL
2) UTILISATEURS
3) BDD
4) TRESORERIE


Feuille  ACCUEIL
Dans cette feuille ajoutez un  Contrôles ActiveX via l'onglet DEVELOPPEUR puis Insérer
un Bouton de commande (Contrôle ActiveX)

PS : la capture d'écran est faite sous Excel 2013 mais c'est identique sous les versions antérieures.

Nous effectuerons la programmation de ce bouton ultérieurement.


Feuille  UTILISATEURS
Dans cette onglet, créez quatre colonne avec les intitulés suivant :
a) NOMS
b) MDP
c) NIVEAU
d) DATE_ACTIVE

Renseignez votre tableau comme bon vous semble ou suivez l'exemple ci-après :

Dans cette même feuille Sélectionnez la plage A1:D5 (Augmentez la plage si vous souhaitez plus de données utilisateurs)
Cliquez sur l'onglet FORMULES puis sur Gestionnaire de noms
A l'ouverture du formulaire Gestionnaire de noms cliquez sur Nouveau
Dans l'environnement Nom :  indiquez le mot NOMS
Fait référence à : doit correspondre à la plage de cellules que vous avez sélectionnée.
Cliquez sur OK






Pour les deux autres feuilles (BDD et TRESORERIE) = pas de paramétrages particuliers.


PROGRAMMATION


Maintenant sélection la feuille  ACCUEIL
Dans le menu cliquez sur l'onglet DÉVELOPPEUR puis dans Contrôles cliquez sur Mode Création.

PS : la capture d'écran est faite sous Excel 2013 mais c'est identique sous les versions antérieures.

Sélectionnez votre bouton sur la feuille et Double-Cliquez sur celui-ci pour ouvrir le VBAProject

Maintenant dans Propriétés - CommandButton  à la ligne Caption changez le nom CommandButton1 par ACCES.

Éventuellement vous pouvez changer la taille de la police et la Font.

A droite ajouter le code suivant :
Private Sub CommandButton1_Click()
UserForm1.Show
End Sub


Donc la programmation du bouton de commande ACCES de la feuille ACCUEIL est programmé.
Cette programmation va vous permettre d'ouvrir le formulaire que nous allons créer maintenant.



CREATION DU FORMULAIRE
  Vous êtes toujours dans le VBAProject.
Cliquez sur l'onglet Insertion  et cliquez sur  UserForm

Maintenant insérez (comme expliquez "Créer dans son formulaire" dans le présent blog) :
* Deux TextBox
* Deux CommandButton
* deux  Label
avec la Boîte à outils :


Nommez vos Label respectivement dans Caption :   
* Utilisateur (Login)  => Label1
 * Mot de passe  => Label3

Nommez vos CommandButton respectivement dans Caption :   
* Valider => CommandButton1 
  * Sortie => CommandButton2 

Nommez votre Userform1  respectivement dans Caption  Veuillez saisir votre Login et Mot de passe

Vous devez obtenir ceci :

avec les éléments disposés ainsi

Double-cliquez sur votre formulaire et insérer tous les codes suivants :

Private Sub CommandButton1_Click()
Dim Util As Range 'Déclaration de la variable Utilisateur
Dim Niv As Byte 'Déclaration de la variable Niveau
Static Essais_Util As Byte, Essais_MDP As Byte 'Déclaration des variables Essais

If TextBox1.Value = "" Then 'si la TextBox est vide
    MsgBox "Vous devez remplir le champ Utilisateur", vbCritical, "              Erreur" 'Sécurisation
    Exit Sub 'On sort de la procédure
End If
If TextBox2.Value = "" Then 'si la TextBox est vide
    MsgBox "Vous devez remplir le champ Mot de Passe", vbCritical, "                    Erreur" 'Sécurisation
    Exit Sub 'On sort de la procédure
End If  'Fin de condition

Set Util = Range("NOMS").Find(TextBox1.Value, LookIn:=xlValues, lookat:=xlWhole) 'on recherche le nom d'utilisateur
    If Not Util Is Nothing Then 'Si il exsiste.....(condition)
        If TextBox2.Value = Util.Offset(, 1) Then 'Si le mot de passe est correcte.....(sous-condition)
            Niv = Util.Offset(, 2)   'On enregistre le niveau
            Acces Niv   'Procédure d'accès au niveau
        Else  'Sinon.....(sous-condition)
            Essais_MDP = Essais_MDP + 1  'Variable "Essais_MDP" incrémentée si mot de passe incorrect
            If Essais_MDP > 3 Then ThisWorkbook.Close 0 'Si 3 tentatives incorrectes on ferme le fichier
                MsgBox "Mot de passe incorrect, il vous reste " & 3 - Essais_MDP & " essais", vbCritical, "                              Erreur" 'Message
                    With Me.TextBox2 'avec la TextBox2
                        .Value = ""  'On la vide
                        .SetFocus  'On lui donne le Focus
                    End With  'Fin d'avec la TextBox2
        End If  'Fin de.....(sous condition)
    Else 'Sinon.....(condition)
        Essais_Util = Essais_Util + 1 'Variable "Essais_Util" incrémentée si nom d'utilisateur est incorrect
        If Essais_Util > 3 Then ThisWorkbook.Close 0 'Si 3 tentatives incorrectes on ferme le fichier
            MsgBox "Utilisateur inconnu, il vous reste " & 3 - Essais_Util & " essais", vbCritical, "                              Erreur"   'Message
                With Me.TextBox1 'avec la TextBox1
                    .SetFocus 'On lui donne le Focus
                    .SelStart = 0 'on sélectionne le caractère de départ
                    .SelLength = Len(Me.TextBox1.Text) 'la longueur de sélection = le nombre de caratère affichés dans la TextBox
                End With 'Fin d'avec la TextBox1
        End If 'Fin de condition
End Sub 'Fin de procédure


 
Private Sub CommandButton2_Click()
Unload Me 'On sort de l'UserForm
End Sub
Private Sub UserForm_Initialize()
Dim ws As Worksheet 'Déclaration de la variable feuille
For Each ws In Worksheets 'Boucle sur chaque feuille du fichier
    If ws.Name <> "ACCUEIL" Then 'Si les feuilles ont un nom différent de "MENU_SAISIE"
        ws.Visible = xlSheetVeryHidden 'Les feuilles seront cachées et "Afficher" grisé dans le menu contextuel sur clic droit de la souris sur l'onglet
    End If 'Fin de condition
Next ws  'Feuille suivante
Sheets("ACCUEIL").Shapes("Bouton 1").Visible = False 'On cache le bouton "Saisie des Données" (accès à l'userForm)
With Me  'Avec l'UserForm
    .TextBox2.PasswordChar = "*" 'les caractères entrés seront convertis en "*"
End With  'Fin de avec l'UserForm 
TextBox1.SetFocus   'On donne le Focus à la TextBox1
End Sub   'Fin de procédure

 
Private Sub Acces(Niveau As Byte)
Select Case Niveau 'On sélectionne les différents niveaux
    Case 1 'Niveau 1
            Call ChangeCode 'Appel de la procédure de changement de code pour voir si dépassement des 30jours
            If Sheets("ACCUEIL").Range("VDX1000").Value = 1 Then 'Si réponse "non" au changement de code (macro changeCode), on arrête tout
                TextBox1.Value = ""  'On vide la TextBox1
                TextBox2.Value = ""  'On vide la TextBox2
                TextBox1.SetFocus  'On donne le Focus à la TextBox1
                Exit Sub
            End If
                Sheets("ACCUEIL").Shapes("Bouton 1").Visible = True 'On rend visible le bouton 5 pour affichage du formulaire
                Sheets("BDD").Visible = True 'On rend la feuille visible
                 Sheets("UTILISATEURS").Visible = True 'On rend la feuille visible
                Sheets("TRESORERIE").Visible = True 'On rend la feuille visible 
            Unload Me
           
    Case 2
            Call ChangeCode   'Appel de la procédure de changement de code pour voir si dépassement des 30jours
            If Sheets("ACCUEIL").Range("VDX1000").Value = 1 Then 'Si réponse "non" au changement de code (macro changeCode), on arrête tout
                TextBox1.Value = ""   'On vide la TextBox1
                TextBox2.Value = ""   'On vide la TextBox2
                TextBox1.SetFocus   'On donne le Focus à la TextBox1
                Exit Sub
            End If
                Application.ScreenUpdating = False 'Arrêt de la mise à jour de l'écran
                Sheets("ACCUEIL").Shapes("Bouton 1").Visible = True 'On rend visible le bouton 5 pour affichage du formulaire
                Sheets("BDD").Visible = True 'On rend la feuille visible
                Sheets("TRESORERIE").Visible = True 'On rend la feuille visible  
                Application.ScreenUpdating = True 'On autorise la mise à jour de l'écran
               
   Case 3
            Call ChangeCode 'Appel de la procédure de changement de code pour voir si dépassement des 30jours
            If Sheets("ACCUEIL").Range("VDX1000").Value = 1 Then 'Si réponse "non" au changement de code (macro changeCode), on arrête tout
                TextBox1.Value = "" 'On vide la TextBox1
                TextBox2.Value = "" 'On vide la TextBox2
                TextBox1.SetFocus 'On donne le Focus à la TextBox1
                Exit Sub
            End If
                Application.ScreenUpdating = False 'Arrêt de la mise à jour de l'écran
                Sheets("BDD").Visible = True   'On rend la feuille visible 
               Sheets("ACCUEIL").Shapes("Bouton 1").Visible = True 'On rend visible le bouton 5 pour affichage du formulaire
                Application.ScreenUpdating = True 'On autorise la mise à jour de l'écran 
End Select 'Fin de sélection
Unload Me 'On sort de l'UserForm
End Sub 'Fin de procédure
 

Private Sub ChangeCode()
Dim Util As Range 'Déclaration de la variable Utilisateur
Sheets("ACCUEIL").Range("VDX1000").Value = 0 'On réinitialise la cellule "VDX1000"
Set Util = Range("NOMS").Find(TextBox1.Value, LookIn:=xlValues, lookat:=xlWhole) 'on recherche le nom d'utilisateur
    If (Now - Util.Offset(0, 3)) > 30 Then 'Si la date Utilisateur est supérieur à aujourd'hui + 30 jours
        Select Case MsgBox("La validité de vos droits arrive à échéance" & vbCrLf & _
               "Vous devez saisir vos nouveaux codes" & vbCrLf & _
                "Voulez vous le faire maintenant ? ", vbQuestion + vbYesNo, "       Validité du code à échéance") 'Message
            Case vbYes 'Si appuis sur "oui"
                UserForm2.TextBox1.SetFocus 'On donne le Focus à la TextBox1 de l'UserForm6 (Chgt de code)
                UserForm2.Show 'Affichage de l'UserForm6 (Chgt de code)
            Case vbNo 'Si appuis sur "non"
               Sheets("ACCUEIL").Range("VDX1000").Value = 1  ' variable d'invalidation de la procédure (on arrête tout)
                Exit Sub 'On sort de la procédure
        End Select 'Fin de sélection
End If 'Fin de condition
End Sub 'Fin de procédure


Donc votre formulaire fonctionne si les mots de passe et les Login sont corrects, mais il y a une condition supplémentaire c'est la DATE de VALIDITÉ du mot de passe.
Celle-ci on l'a indiqué dans l'onglet UTILISATEURS en colonne D (DATE_ACTIVE)



Donc quand cette date sera dépassée de 30 jours,  il va falloir recréer un mot de passe avec une nouvelle date de validité.
Pour ce faire nous allons créer nouveau formulaire.


CREATION DU FORMULAIRE

Maintenant insérez (comme expliquez "Créer dans son formulaire" dans le présent blog) :
* Trois TextBox
* Deux CommandButton
* Trois  Label


Nommez vos Label respectivement dans Caption :   
* Ancien Mot de Passe => Label1
* Nouveau Mot de Passe  => Label2
* Confirmation du Mot de Passe  => Label3


Nommez vos CommandButton respectivement dans Caption :   
* Valider => CommandButton1 
  * Sortie => CommandButton2 

Nommez votre Userform1  respectivement dans Caption  MISE A JOURS Mot de Passe

Vous devez obtenir ceci :

Double-cliquez sur votre formulaire et insérer tous les codes suivants :

 
Private Sub CommandButton1_Click()
Dim Valid As Byte 'déclaration de la variable Validation
Dim Util As Range 'déclaration de la variable Utilisateur
Dim ws As Worksheet 'déclaration de la variable WorkSheet

If TextBox1.Value <> UserForm1.TextBox2.Value Then 'Si le mot de passe est différent que celui saisis sur l'autre UserForm
    MsgBox "Mauvais Mot de Passe" & vbCrLf & "Veuillez le ressaisir", vbCritical, "                  ATTENTION" 'Message
        With TextBox1   'Avec le champ 1
            .SetFocus       'On donne le Focus
            .SelStart = 0 'On sélectionne le premier caractère
            .SelLength = Len(TextBox1.Text)   'On sélectionne la longueur total du texte
        End With   'Fin d'avec le champ 1
        Exit Sub   'On sort de la procédure
    Else: Valid = Valid + 1  'Si condition non rempli incrément de la variable validation
End If   'Fin de condition

If TextBox2.Value = "" Or TextBox3.Value = "" Then   'Si le champ 1 et le champ 2 sont vides
        MsgBox "Vous devez remplir les champs" & vbCrLf & _
        "           (Mot de Passe)", vbCritical, "                  ATTENTION"  'Message
        TextBox2.SetFocus  'On donne le Focus
        Exit Sub   'On sort de la procédure
    Else: Valid = Valid + 1  'Si condition non rempli incrément de la variable validation
End If   'Fin de condition

If TextBox2.Value <> TextBox3.Value Then  'Si le champ 2 est différent du champ 3
        MsgBox "La Confirmation du Mot de Passe" & vbCrLf & _
        "   n'est pas identiques", vbCritical, "                 ATTENTION" 'message
        TextBox2.Value = ""   'On vide le champ 2
        TextBox3.Value = ""   'On vide le champ 3
        TextBox2.SetFocus     'On donne le Focus au champ 2
        Exit Sub                           'On sort de la procédure
    Else: Valid = Valid + 1    'Si condition non rempli incrément de la variable validation
End If    'Fin de condition

If TextBox2.Value = TextBox1.Value Then  'Si le champ 2 est identique au champ 1
        MsgBox "Le Nouveau Mot de Passe" & vbCrLf & _
        "est identique à l'ancien ?", vbCritical, "                 ATTENTION"  'Message
        TextBox2.Value = ""   'On vide le champ 3
        TextBox3.Value = ""   'On vide le champ 3
        TextBox2.SetFocus     'On donne le Focus au champ 2
        Exit Sub  'On sort de la procédure
    Else: Valid = Valid + 1  'Si condition non rempli incrément de la variable validation
End If   'Fin de condition
If Valid = 4 Then  'Si tout est validé
    If Sheets("UTILISATEURS").Visible = True Then 'Si la feuille "Utilisateurs" est visible, donc niveau 2
        Set Util = Range("NOMS").Find(UserForm1.TextBox1.Value, LookIn:=xlValues, lookat:=xlWhole) 'On recherche le nom d'utilisateur
            If Not Util Is Nothing Then  'Si il exsiste
                Util.Offset(, 1) = TextBox2.Value 'On change le mot de passe
                Util.Offset(, 3) = Now 'On réinitialise la date
            End If  'Fin de condition
    End If   'Fin de condition
  
    If Sheets("UTILISATEURS").Visible = xlSheetVeryHidden Then 'si la feuille "Utilisateurs" est invisible, donc niveau 1
        Application.ScreenUpdating = False 'Arrêt de la mise à jour de l'écran
        Sheets("UTILISATEURS").Visible = True 'On rend visible la feuille Utilisateurs
            Set Util = Range("NOMS").Find(UserForm1.TextBox1.Value, LookIn:=xlValues, lookat:=xlWhole) 'on recherche le nom d'utilisateur
                If Not Util Is Nothing Then 'Si il exsiste
                    Util.Offset(, 1) = TextBox2.Value 'On change le mot de passe
                    Util.Offset(, 3) = Now 'On réinitialise la date
                End If 'Fin de condition
        Sheets("UTILISATEURS").Visible = xlSheetVeryHidden 'On cache la feuille "Utilisateurs"
        Application.ScreenUpdating = True 'Mise à jour de l'écran, valide
    End If  'Fin de condition
End If  'Fin de condition
Unload Me 'On quitte l'UserForm
End Sub 'Fin de procédure

Private Sub CommandButton2_Click()
Unload Me   'On sort de l'UserForm
End Sub

Private Sub UserForm_Initialize()
For Each CTRL In Me.Controls  'Boucle sur les controls
    If TypeOf CTRL Is MSForms.TextBox Then  'Si le control est de type TextBox
        CTRL.PasswordChar = "*"   'Les caractères seront "*"
    End If  'Fin de condition
Next  'Control suivant
End Sub  'Fin de procédure

Maintenant pour finaliser votre projet et le sécuriser n'oublier pas  de le protéger avec un mot de passe :
1) Cliquez sur l'onglet  Outils puis sélectionner Propriétés de VBAProject....
2) Dans la fenêtre qui s'ouvre cliquer sur l'onglet Protection.
3) Cocher Verrouiller le projet pour l'affichage
4) Mentionnez votre mot de passe dans Mot de passe et Confirmer le mot de passe 
5) Cliquer  sur OK

N'oubliez surtout pas ce mot de passe car dans le cas contraire l'accès à votre programme sera irrémédiablement INACCESSIBLE