Masquage auto de nouvelles feuilles
Bonjour,
Je bosse actuellement sur un classeur qui à l'ouverture demande un identifiant et un mdp selon le profil de l'utilisateur (admin,boss et user). Après avoir entré les identifiants, l'utilisateur a accès à certaines pages que d'autre n'ont pas.
J'utilise actuellement ce code:
Private Sub BtnLogin_Click()
On Error Resume Next
'declaration variable
Dim Mdp As String
Dim role As String
Dim User As String
Dim Nom As String
'configuration de variable
User = WorksheetFunction.VLookup(TxtUser, Sheets("membres").Range("a:d"), 1, 0)
role = WorksheetFunction.VLookup(TxtUser, Sheets("membres").Range("a:d"), 2, 0)
Mdp = WorksheetFunction.VLookup(TxtUser, Sheets("membres").Range("a:d"), 3, 0)
Nom = WorksheetFunction.VLookup(TxtUser, Sheets("membres").Range("a:d"), 4, 0)
'controler si c'est l'admin
If Mdp = TxtMdP And role = "Admin" Then
'Pages visibles par l'admin après Login
Sheets("Membres").Visible = True
Sheets("ACCUEIL").Visible = True
Sheets("PLANNING_MODIF").Visible = True
Sheets("PLANNING 2019").Visible = True
Sheets("login").Visible = 2
Sheets("ACCUEIL").Activate
'controler si l'utilisateur User est enregistré
ElseIf Mdp = TxtMdP And role = "User" And User = "User" Then
'Pages visibles par User après Login
Sheets("ACCUEIL").Visible = True
Sheets("PLANNING_MODIF").Visible = 2
Sheets("PLANNING 2019").Visible = 2
Sheets("Membres").Visible = 2
Sheets("login").Visible = 2
Sheets("ACCUEIL").Activate
'controler si l'utilisateur Boss est enregistré
ElseIf Mdp = TxtMdP And role = "Boss" And User = "Boss" Then
'Pages visibles par Boss après Login
Sheets("ACCUEIL").Visible = True
Sheets("PLANNING_MODIF").Visible = True
Sheets("PLANNING 2019").Visible = True
Sheets("Membres").Visible = 2
Sheets("login").Visible = 2
Sheets("ACCUEIL").Activate
'Message si l'identifiant ou le Mdp est incorrect
Else
MsgBox "L'utilisateur ou le mot de passe est incorrect"
End If
Sheets("ACCUEIL").Range("b2") = "Bonjour " & Nom
Sheets("PLANNING_MODIF").Range("b2") = "Bonjour " & Nom
Sheets("PLANNING 2019").Range("b2") = "Bonjour " & Nom
'vider le formulaire de connexion
TxtUser = ""
TxtMdP = ""
End Sub
L'utilisateur "boss" a accès aux modifications et à la création de planning alors que les "user"ne l'ont pas. Jusqu'ici tout va bien...
Là où je bloque dans mon code, c'est lorsque "boss" créer un nouveau planning (donc une nouvelle feuille), je voudrais que cette feuille soit automatiquement cachée dans les onglets pour les "user" sans devoir rajouter les lignes de code nécessaires pour masquer les onglets à chaque profil.
J'avais pensé faire un tableau avec l'incrémentation auto des nouvelles feuilles créées qui auront le nom sous ce format :"PLANNING 20**" et ensuite utiliser ce tableau dans une boucle qui rechercherait toutes les feuilles existantes sous ce format pour enfin les cacher selon le profil connecté.
Je ne sais pas si cette piste est bonne et n'étant pas un expert en vba, je risque d'y passer beaucoup de temps si ce n'est pas le cas.
J'espère avoir été assez clair dans mon explication.
Je mets le classeur en pièce jointe et voici les identifiants très recherchés de chaque profil
ID=Admin Mdp=Admin
ID=Boss Mdp=Boss
ID=User Mdp=USer
Merci d'avance
- Messages
- 1'025
- Excel
- 2016 FR // 365
- Inscrit
- 19/04/2019
- Emploi
- Étudiant en 5e année d'école d'Ingénieur
Salut Fredo590,
En fonction de la personne qui entre dans le fichier, tu montres ou non certaines feuilles.
Pourquoi ne pas simplement coder pour User :
Dim sh As Worksheet
For Each sh In ThisWorkbook.Sheets
sh.Visible = 2
Next
Sheets("ACCUEIL").Visible = True
Et pour admin tu met tout à True
et pour boss tout à True
sauf la page admin
Cordialement,
Baboutz
PS : Très stylé ton excel
Edit : Tu devrais mettre ce code :
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Application.DisplayFullScreen = False
End Sub
Car sinon quand tu ouvres un autre classeur Excel par la suite, il est en plein écran, ce qui peux être gênant
Salut Baboutz,
En fait, je prenais le problème à l'envers.
C'est beaucoup plus simple comme ça et c'est impeccable!
Un grand merci à toi
PS: Merci pour les petits ajustements
Cordialement
bonnjout,
La macro NouveauPlanning fit référence à :
Sheets("PLANNING").Range("_ANNEE").... qui n'existe pas ! Difficile dans ces conditions de te faire une proposition.
D'autant plus que tu vas avoir une ribambelle de ("_ANNEE") ou il sera difficile d'y retrouver ses petits... et surtout de faire le joint pendant la période charnière : Tu devras te livrer à un petit jeu de chaise musicale ou je voudrai pas être à ta place :
Entre les années de niveaux classeur et les années de niveaux Sheet, ça va être le b...
Je ne te donnerai pas de conseil sur la meilleure manière de faire.
Personnellement je pense que je gèrerai l'affaire comme ça : Suppression de tes _ANNEE et création d'un Nom "invisible dans le Gestionnaire" : _An19 qui ne se réfère à aucune feuille et dont le RefersTo est 2019. C'est fait et appliqué dans le classeur.
Et tes plannings de cette année se réfèrent bien au nouveau nom.
Ce nom se manipule de la même manière qu'un nom ordinaire : Si tu tapes dans la fenêtre d'exécution ?[_An19] la fenêtre d'exécution te renvoie bien 2019
Le moment venu à partir de la feuille planning tu créeras le nom "_An20" dont le RefersTo sera 2020 et après TORAPUKA faire le ménage dans tes feuilles... tranquillement. Je t'ai laissé la macro de création du nom "_An20" (Module 5) mais pour la sub Nouveau_Planning tu devras te gratter un peu la tête... Elle fonctionne déjà mais il y aura peut-être matière à revoir.
Important : Les feuilles "Admin" sont toutes préfixés dans leur CodeName avec "Ws" : Je gère le login avec ça et la macro nouveau planning créera un nouveau planning avec le CodeName "Ws20"
Regarde bien dans "PLANNING 2019" J'ai laissé la cellule F10 ce qui prouve que c'est bien le nouveau nom qui est pris en compte.
De même si tu supprimes cette cellule F10 la cellule D10 elle fait toujours référence à 2019. Tout cela prouve bien qu'on peut piloter 2019 avec ce nom dans tous les cellules de tes plannings 2019
Bon enfin moi j'y voie comme ça. Peut-être que quelqu'un aura quelque chose de plus simple ? Mébon c'est jamais simple de vouloir faire des classeurs perpétuels...
A+
[EDIT] Je fais la gueule à personne mais malgré que je fasse quelques aperçus avant d'envoyer je ne vois jamais si quelqu'un d'autre à déjà répondu comme c'est le cas... Alors BONTENPI... Salut les gars !