Microsoft 365 Afficher des onglets masqués selon un critères

Roseline

XLDnaute Occasionnel
Bonjour,
Je cherche la solution à mon problème et j'ai testé plusieurs vba que j'ai trouvé sur le forum mais rien ne fonctionne. J'espère que vous pourrez m'aider.
J'ai joint un fichier, actuellement quand on inscrit le nom de la personne dans la cellule A3 et qu'on clique sur le bouton "contact" un onglet (identique) est créer automatiquement à ce même nom. Jusque là tout va bien.
Dans chaque onglet qui sera crée, mon accompagneur, cellule B3 sera différent. J'aimerais attribuer un mot de passe différent à chaque accompagnateur et qu'à l'ouverture du fichier il y ait un msgbox demandant le mot de passe, et tous les onglets correspondant au nom de l'accompagnateur s'afficherait. Les autres demeureraient masqués naturellement.
A la fermeture du fichier tous les onglets se masqueraient et s'enregistreraient sauf le template qui demeure visible.
Est-ce que quelqu'un pourrait m'aider svp.
Merci beaucoup et bonne journée
 

Pièces jointes

  • Liste contact (2).xlsm
    30 KB · Affichages: 8
Solution
Bonjour à tous, Bonjour @Roseline

Un exemple de ce qui peut être fait :
  • Le Projet VBA est verrouillé (et masqué) Mot de Passe Provisoire "MdP"
  • Une feuille "MdP" contient un tableau structuré avec le nom des accompagnateurs et leur mot de passe, cette feuille est masquée "xlSheetVeryHidden" (elle ne peut pas être affichée par l'interface Excel).
  • Les feuilles crées par le bouton "Contact" sont masquées de la même façon.
A l'ouverture du classeur, si le nombre de feuilles est > 2, un formulaire s'affiche :
1644936454959.png

Si il y a des feuilles correspondant au couple (Nom, Mot de passe) elles sont affichées (la première est activée).
Sinon seule la feuille "Template" reste visible.

A la fermeture du...

AtTheOne

XLDnaute Impliqué
Supporter XLD
Bonjour à tous, Bonjour @Roseline

Un exemple de ce qui peut être fait :
  • Le Projet VBA est verrouillé (et masqué) Mot de Passe Provisoire "MdP"
  • Une feuille "MdP" contient un tableau structuré avec le nom des accompagnateurs et leur mot de passe, cette feuille est masquée "xlSheetVeryHidden" (elle ne peut pas être affichée par l'interface Excel).
  • Les feuilles crées par le bouton "Contact" sont masquées de la même façon.
A l'ouverture du classeur, si le nombre de feuilles est > 2, un formulaire s'affiche :
1644936454959.png

Si il y a des feuilles correspondant au couple (Nom, Mot de passe) elles sont affichées (la première est activée).
Sinon seule la feuille "Template" reste visible.

A la fermeture du classeur toutes les feuilles autre que "Template" sont masquées (xlSheetVeryHidden).

Lorsque l'on clique sur le bouton contact, si c'est possible, on crée une nouvelle feuille masquée (xlSheetVeryHidden). Si le mot de passe de l'accompagnateur n'est pas connu, un dialogue s'engage pour le créer.
Le mot de passe Administrateur est stocké dans une constante dans le module
M01_Constantes_Publques :
Code:
Option Private Module
Public Const MdP_Admin As String = "MdP"

Code de ThisWorkbook :
VB:
Private Sub Workbook_BeforeClose(Cancel As Boolean)
   
     For i = 2 To Sheets.Count
          Sheets(i).Visible = xlSheetVeryHidden
     Next
   
End Sub

Private Sub Workbook_Open()

     If Worksheets.Count > 2 Then UsF_Accès.Show
   
End Sub

Code de Template
Code:
Private Sub Création()

     Dim OT As Worksheet  'déclare la variale OT (Onglet Template)
     Dim O As Worksheet   'déclare la variale O (Onglet)
     Dim Nom As String, Tb
   
     Set OT = Worksheets("Template") 'définit l'onglet OT
     If WorksheetFunction.CountA(OT.[A3:C3]) <> 3 Then
          OT.[A3:C3].Find(What:="", After:=OT.[C3], LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows).Select
          MsgBox "Vous devez renseigner cette cellule !"
          Exit Sub 'sort de la procédure
     End If
   
     Nom = OT.[A3] 'Nom du contact
     On Error Resume Next: Set O = Worksheets(Nom): On Error GoTo 0
     If Not O Is Nothing Then
          MsgBox "Un onglet portant le nom de " & Chr(34) & Nom & Chr(34) & " exite déjà !"
          Exit Sub 'sort de la procédure
     End If
   
     OT.Copy After:=Sheets(Sheets.Count): Set O = ActiveSheet: O.Name = Nom: O.Visible = xlSheetVeryHidden
     OT.[A3:C3].ClearContents
     With Sh02_MdP.ListObjects(1)
          Tb = .Range.Offset(1).Resize(.Range.Rows.Count - 1).Value
     End With
     OK = False
     Nom = O.[B3]
     For i = 1 To UBound(Tb, 1)
          If UCase(Tb(i, 1)) = UCase(Nom) Then OK = True: Exit For
     Next i
     If Not OK Then
          Créer_Mdp Nom
     End If
 
End Sub

Private Sub Créer_Mdp(Nom As String)
Dim Rép, Rép1, Rép2, Lgn As Long
   
     'Demande du mot de passe administrateur
     Rép = Application.InputBox(Title:="Ajout d'un contact", Prompt:="Mot de Passe Administrateur :", Type:=2)
     If Rép = False Or Rép = "" Or Rép <> MdP_Admin Then
          'En cas d'erreur abandon de la création d'un mot de passe
          MsgBox "Erreur sur le mot de passe" & vbCrLf & "Il faudra ajouter le mot de passe de " & Nom & "manuellement.": Exit Sub
     End If
   
     Rép1 = Application.InputBox(Title:="Mot de passe d'un contact", Prompt:="Mot de passe de " & Nom & " :", Type:=2)
     Rép2 = Application.InputBox(Title:="Confirmation", Prompt:="Confirmez le mot de passe de " & Nom & " :", Type:=2)
     If Rép2 = False Or Rép2 = "" Or Rép2 <> Rép1 Then
          'En cas d'erreur abandon de la création d'un mot de passe
          MsgBox "Erreur sur le mot de passe" & vbCrLf & "Il faudra ajouter le mot de passe de " & Nom & "manuellement.": Exit Sub
     End If
   
     With Sh02_MdP
          'N° de la dernière ligne
          Lgn = .Cells(.Rows.Count, 1).End(xlUp).Row
          Lgn = Lgn + Abs(.Cells(Lgn, 1) <> "")  '(si le tableau et vide cette ligne sinon la suivante)
          .Cells(Lgn, 1) = Nom     'Nom
          .Cells(Lgn, 2) = Rép2    'Mot de passe
     End With
   
End Sub

Private Sub Masquer()
     'Masquer toutes les feuilles
     For i = 1 To Sheets.Count
          Sheets(i).Visible = xlSheetVeryHidden
     Next

End Sub


Private Sub Afficher()
     'Afficher toutes les feuilles sauf la 1
     For i = 2 To Sheets.Count
          Sheets(i).Visible = xlSheetVisible
     Next

End Sub

Code du Formulaire USF_Accès
Code:
Private Sub CBn_Abandon_Click()
     Me.Hide
     Unload Me
End Sub

Private Sub CBn_Valider_Click()

     Dim OK As Boolean, Trouvé As Boolean, Nom As String, MdP As String, Tb, i As Integer
     Dim O As Worksheet, t As Integer
   
     If Me.TBx_Nom = "" Or Me.TBx_MdP = "" Then
          MsgBox "Renseignez d'abord Nom et Mot de Passe !"
          Exit Sub
     End If
   
     Nom = UCase(Me.TBx_Nom.Text): MdP = Me.TBx_MdP.Text
     Tb = Sh02_MdP.ListObjects(1).DataBodyRange.Value
     OK = False
     For i = 1 To UBound(Tb, 1)
          If UCase(Tb(i, 1)) = Nom And Tb(i, 2) = MdP Then OK = True: Exit For
     Next i
     If Not OK Then Me.Lbl_Msg.Visible = True: Exit Sub
   
     Trouvé = False
     t = 0
     For i = 2 To Worksheets.Count
          If Worksheets(i).Name <> "MdP" And UCase(Worksheets(i).[B3]) = Nom Then
               Worksheets(i).Visible = xlSheetVisible: Trouvé = True
               If t = 0 Then t = i
          End If
     Next
     If Not Trouvé Then MsgBox "Aucune feuille disponible à votre nom !" Else Worksheets(t).Activate
     Me.Hide
     Unload Me
End Sub

Private Sub TBx_MdP_Change()
     Me.Lbl_Msg.Visible = False
End Sub

Private Sub TBx_Nom_Change()
     Me.Lbl_Msg.Visible = False
End Sub

Voilà, bon courage
Amicalement
Alain
 

Pièces jointes

  • Liste contact.xlsm
    36 KB · Affichages: 6

Roseline

XLDnaute Occasionnel
Bonjour à tous, Bonjour @Roseline

Un exemple de ce qui peut être fait :
  • Le Projet VBA est verrouillé (et masqué) Mot de Passe Provisoire "MdP"
  • Une feuille "MdP" contient un tableau structuré avec le nom des accompagnateurs et leur mot de passe, cette feuille est masquée "xlSheetVeryHidden" (elle ne peut pas être affichée par l'interface Excel).
  • Les feuilles crées par le bouton "Contact" sont masquées de la même façon.
A l'ouverture du classeur, si le nombre de feuilles est > 2, un formulaire s'affiche :
Regarde la pièce jointe 1130942
Si il y a des feuilles correspondant au couple (Nom, Mot de passe) elles sont affichées (la première est activée).
Sinon seule la feuille "Template" reste visible.

A la fermeture du classeur toutes les feuilles autre que "Template" sont masquées (xlSheetVeryHidden).

Lorsque l'on clique sur le bouton contact, si c'est possible, on crée une nouvelle feuille masquée (xlSheetVeryHidden). Si le mot de passe de l'accompagnateur n'est pas connu, un dialogue s'engage pour le créer.
Le mot de passe Administrateur est stocké dans une constante dans le module
M01_Constantes_Publques :
Code:
Option Private Module
Public Const MdP_Admin As String = "MdP"

Code de ThisWorkbook :
VB:
Private Sub Workbook_BeforeClose(Cancel As Boolean)
  
     For i = 2 To Sheets.Count
          Sheets(i).Visible = xlSheetVeryHidden
     Next
  
End Sub

Private Sub Workbook_Open()

     If Worksheets.Count > 2 Then UsF_Accès.Show
  
End Sub

Code de Template
Code:
Private Sub Création()

     Dim OT As Worksheet  'déclare la variale OT (Onglet Template)
     Dim O As Worksheet   'déclare la variale O (Onglet)
     Dim Nom As String, Tb
  
     Set OT = Worksheets("Template") 'définit l'onglet OT
     If WorksheetFunction.CountA(OT.[A3:C3]) <> 3 Then
          OT.[A3:C3].Find(What:="", After:=OT.[C3], LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows).Select
          MsgBox "Vous devez renseigner cette cellule !"
          Exit Sub 'sort de la procédure
     End If
  
     Nom = OT.[A3] 'Nom du contact
     On Error Resume Next: Set O = Worksheets(Nom): On Error GoTo 0
     If Not O Is Nothing Then
          MsgBox "Un onglet portant le nom de " & Chr(34) & Nom & Chr(34) & " exite déjà !"
          Exit Sub 'sort de la procédure
     End If
  
     OT.Copy After:=Sheets(Sheets.Count): Set O = ActiveSheet: O.Name = Nom: O.Visible = xlSheetVeryHidden
     OT.[A3:C3].ClearContents
     With Sh02_MdP.ListObjects(1)
          Tb = .Range.Offset(1).Resize(.Range.Rows.Count - 1).Value
     End With
     OK = False
     Nom = O.[B3]
     For i = 1 To UBound(Tb, 1)
          If UCase(Tb(i, 1)) = UCase(Nom) Then OK = True: Exit For
     Next i
     If Not OK Then
          Créer_Mdp Nom
     End If
 
End Sub

Private Sub Créer_Mdp(Nom As String)
Dim Rép, Rép1, Rép2, Lgn As Long
  
     'Demande du mot de passe administrateur
     Rép = Application.InputBox(Title:="Ajout d'un contact", Prompt:="Mot de Passe Administrateur :", Type:=2)
     If Rép = False Or Rép = "" Or Rép <> MdP_Admin Then
          'En cas d'erreur abandon de la création d'un mot de passe
          MsgBox "Erreur sur le mot de passe" & vbCrLf & "Il faudra ajouter le mot de passe de " & Nom & "manuellement.": Exit Sub
     End If
  
     Rép1 = Application.InputBox(Title:="Mot de passe d'un contact", Prompt:="Mot de passe de " & Nom & " :", Type:=2)
     Rép2 = Application.InputBox(Title:="Confirmation", Prompt:="Confirmez le mot de passe de " & Nom & " :", Type:=2)
     If Rép2 = False Or Rép2 = "" Or Rép2 <> Rép1 Then
          'En cas d'erreur abandon de la création d'un mot de passe
          MsgBox "Erreur sur le mot de passe" & vbCrLf & "Il faudra ajouter le mot de passe de " & Nom & "manuellement.": Exit Sub
     End If
  
     With Sh02_MdP
          'N° de la dernière ligne
          Lgn = .Cells(.Rows.Count, 1).End(xlUp).Row
          Lgn = Lgn + Abs(.Cells(Lgn, 1) <> "")  '(si le tableau et vide cette ligne sinon la suivante)
          .Cells(Lgn, 1) = Nom     'Nom
          .Cells(Lgn, 2) = Rép2    'Mot de passe
     End With
  
End Sub

Private Sub Masquer()
     'Masquer toutes les feuilles
     For i = 1 To Sheets.Count
          Sheets(i).Visible = xlSheetVeryHidden
     Next

End Sub


Private Sub Afficher()
     'Afficher toutes les feuilles sauf la 1
     For i = 2 To Sheets.Count
[QUOTE="AtTheOne, post: 20489889, member: 358137"]
Bonjour à tous, Bonjour [USER=209912]@Roseline[/USER]

Un exemple de ce qui peut être fait :
[LIST]
[*]Le Projet VBA est verrouillé (et masqué) Mot de Passe Provisoire "MdP"
[*]Une feuille "MdP" contient un tableau structuré avec le nom des accompagnateurs et leur mot de passe, cette feuille est masquée "xlSheetVeryHidden" (elle ne peut pas être affichée par l'interface Excel).
[*]Les feuilles crées par le bouton "Contact" sont masquées de la même façon.
[/LIST]
A l'ouverture du classeur, si le nombre de feuilles est > 2, un formulaire s'affiche :
[ATTACH type="full" alt="1644936454959.png"]1130942[/ATTACH]
Si il y a des feuilles correspondant au couple (Nom, Mot de passe) elles sont affichées (la première est activée).
Sinon seule la feuille "Template" reste visible.

A la fermeture du classeur toutes les feuilles autre que "Template" sont masquées (xlSheetVeryHidden).

Lorsque l'on clique sur le bouton contact, si c'est possible, on crée une nouvelle feuille  masquée (xlSheetVeryHidden). Si le mot de passe de l'accompagnateur n'est pas connu, un dialogue s'engage pour le créer.
Le mot de passe Administrateur est stocké dans une constante dans le module
M01_Constantes_Publques :
[CODE]Option Private Module
Public Const MdP_Admin As String = "MdP"

Code de ThisWorkbook :
VB:
Private Sub Workbook_BeforeClose(Cancel As Boolean)
  
     For i = 2 To Sheets.Count
          Sheets(i).Visible = xlSheetVeryHidden
     Next
  
End Sub

Private Sub Workbook_Open()

     If Worksheets.Count > 2 Then UsF_Accès.Show
  
End Sub

Code de Template
Code:
Private Sub Création()

     Dim OT As Worksheet  'déclare la variale OT (Onglet Template)
     Dim O As Worksheet   'déclare la variale O (Onglet)
     Dim Nom As String, Tb
  
     Set OT = Worksheets("Template") 'définit l'onglet OT
     If WorksheetFunction.CountA(OT.[A3:C3]) <> 3 Then
          OT.[A3:C3].Find(What:="", After:=OT.[C3], LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows).Select
          MsgBox "Vous devez renseigner cette cellule !"
          Exit Sub 'sort de la procédure
     End If
  
     Nom = OT.[A3] 'Nom du contact
     On Error Resume Next: Set O = Worksheets(Nom): On Error GoTo 0
     If Not O Is Nothing Then
          MsgBox "Un onglet portant le nom de " & Chr(34) & Nom & Chr(34) & " exite déjà !"
          Exit Sub 'sort de la procédure
     End If
  
     OT.Copy After:=Sheets(Sheets.Count): Set O = ActiveSheet: O.Name = Nom: O.Visible = xlSheetVeryHidden
     OT.[A3:C3].ClearContents
     With Sh02_MdP.ListObjects(1)
          Tb = .Range.Offset(1).Resize(.Range.Rows.Count - 1).Value
     End With
     OK = False
     Nom = O.[B3]
     For i = 1 To UBound(Tb, 1)
          If UCase(Tb(i, 1)) = UCase(Nom) Then OK = True: Exit For
     Next i
     If Not OK Then
          Créer_Mdp Nom
     End If
 
End Sub

Private Sub Créer_Mdp(Nom As String)
Dim Rép, Rép1, Rép2, Lgn As Long
  
     'Demande du mot de passe administrateur
     Rép = Application.InputBox(Title:="Ajout d'un contact", Prompt:="Mot de Passe Administrateur :", Type:=2)
     If Rép = False Or Rép = "" Or Rép <> MdP_Admin Then
          'En cas d'erreur abandon de la création d'un mot de passe
          MsgBox "Erreur sur le mot de passe" & vbCrLf & "Il faudra ajouter le mot de passe de " & Nom & "manuellement.": Exit Sub
     End If
  
     Rép1 = Application.InputBox(Title:="Mot de passe d'un contact", Prompt:="Mot de passe de " & Nom & " :", Type:=2)
     Rép2 = Application.InputBox(Title:="Confirmation", Prompt:="Confirmez le mot de passe de " & Nom & " :", Type:=2)
     If Rép2 = False Or Rép2 = "" Or Rép2 <> Rép1 Then
          'En cas d'erreur abandon de la création d'un mot de passe
          MsgBox "Erreur sur le mot de passe" & vbCrLf & "Il faudra ajouter le mot de passe de " & Nom & "manuellement.": Exit Sub
     End If
  
     With Sh02_MdP
          'N° de la dernière ligne
          Lgn = .Cells(.Rows.Count, 1).End(xlUp).Row
          Lgn = Lgn + Abs(.Cells(Lgn, 1) <> "")  '(si le tableau et vide cette ligne sinon la suivante)
          .Cells(Lgn, 1) = Nom     'Nom
          .Cells(Lgn, 2) = Rép2    'Mot de passe
     End With
  
End Sub

Private Sub Masquer()
     'Masquer toutes les feuilles
     For i = 1 To Sheets.Count
          Sheets(i).Visible = xlSheetVeryHidden
     Next

End Sub


Private Sub Afficher()
     'Afficher toutes les feuilles sauf la 1
     For i = 2 To Sheets.Count
          Sheets(i).Visible = xlSheetVisible
     Next

End Sub

Code du Formulaire USF_Accès
Code:
Private Sub CBn_Abandon_Click()
     Me.Hide
     Unload Me
End Sub

Private Sub CBn_Valider_Click()

     Dim OK As Boolean, Trouvé As Boolean, Nom As String, MdP As String, Tb, i As Integer
     Dim O As Worksheet, t As Integer
  
     If Me.TBx_Nom = "" Or Me.TBx_MdP = "" Then
          MsgBox "Renseignez d'abord Nom et Mot de Passe !"
          Exit Sub
     End If
  
     Nom = UCase(Me.TBx_Nom.Text): MdP = Me.TBx_MdP.Text
     Tb = Sh02_MdP.ListObjects(1).DataBodyRange.Value
     OK = False
     For i = 1 To UBound(Tb, 1)
          If UCase(Tb(i, 1)) = Nom And Tb(i, 2) = MdP Then OK = True: Exit For
     Next i
     If Not OK Then Me.Lbl_Msg.Visible = True: Exit Sub
  
     Trouvé = False
     t = 0
     For i = 2 To Worksheets.Count
          If Worksheets(i).Name <> "MdP" And UCase(Worksheets(i).[B3]) = Nom Then
               Worksheets(i).Visible = xlSheetVisible: Trouvé = True
               If t = 0 Then t = i
          End If
     Next
     If Not Trouvé Then MsgBox "Aucune feuille disponible à votre nom !" Else Worksheets(t).Activate
     Me.Hide
     Unload Me
End Sub

Private Sub TBx_MdP_Change()
     Me.Lbl_Msg.Visible = False
End Sub

Private Sub TBx_Nom_Change()
     Me.Lbl_Msg.Visible = False
End Sub

Voilà, bon courage
Amicalement
Alain
[/QUOTE]
Sheets(i).Visible = xlSheetVisible
Next

End Sub

[/CODE]

Code du Formulaire USF_Accès
Code:
Private Sub CBn_Abandon_Click()
     Me.Hide
     Unload Me
End Sub

Private Sub CBn_Valider_Click()

     Dim OK As Boolean, Trouvé As Boolean, Nom As String, MdP As String, Tb, i As Integer
     Dim O As Worksheet, t As Integer
  
     If Me.TBx_Nom = "" Or Me.TBx_MdP = "" Then
          MsgBox "Renseignez d'abord Nom et Mot de Passe !"mp
          Exit Sub
     End If
  
     Nom = UCase(Me.TBx_Nom.Text): MdP = Me.TBx_MdP.Text
     Tb = Sh02_MdP.ListObjects(1).DataBodyRange.Value
     OK = False
     For i = 1 To UBound(Tb, 1)
          If UCase(Tb(i, 1)) = Nom And Tb(i, 2) = MdP Then OK = True: Exit For
     Next i
     If Not OK Then Me.Lbl_Msg.Visible = True: Exit Sub
  
     Trouvé = False
     t = 0
     For i = 2 To Worksheets.Count
          If Worksheets(i).Name <> "MdP" And UCase(Worksheets(i).[B3]) = Nom Then
               Worksheets(i).Visible = xlSheetVisible: Trouvé = True
               If t = 0 Then t = i
          End If
     Next
     If Not Trouvé Then MsgBox "Aucune feuille disponible à votre nom !" Else Worksheets(t).Activate
     Me.Hide
     Unload Me
End Sub

Private Sub TBx_MdP_Change()
     Me.Lbl_Msg.Visible = False
End Sub

Private Sub TBx_Nom_Change()
     Me.Lbl_Msg.Visible = False
End Sub

Voilà, bon courage
Amicalement
Alain
 

Roseline

XLDnaute Occasionnel
Bonsoir @Roseline
Tu voulais dire quelque chose ?
Alain
Bonjour,
Problème d'ordinateur désolé. Oui je voulais te remercier pour ce que tu as fait dans ce fichier. J'ai eu un peu de difficulté à comprendre tout le code car je suis pas aussi Experte que toi mais avec bien de l'attention j'ai réussi à suivre le cheminement et le comprendre. Tu es un AS dans la programmation et ce que tu as fait me convient parfaitement.
Je te remercie encore pour ta précieuse aide.
Bonne journée :)
 

Discussions similaires