Option Explicit
Sub VoirFeuille()
   Dim Nom As String, Rép As String, Wsh As Worksheet, CodAcc#, CodCry#
   Nom = InputBox("Nom ?"): If Nom = "" Then Exit Sub
   On Error Resume Next
   Set Wsh = ThisWorkbook.Worksheets(Nom)
   If Err Then MsgBox "il n'existe pas de feuille """ & Nom & """.", _
      vbCritical, "Voir feuille": Exit Sub
   CodCry = CodeCrypté(InputBox("Mot de passe ?"))
   CodAcc = Wsh.[CodeDAccès]
   If Err Then
      If CodeCrypté(InputBox("Confirmez ce mot de passe SVP.")) <> CodCry _
         Then MsgBox "Accès dénié.", vbCritical, "Voir feuille": Exit Sub
      Wsh.Names.Add "CodeDAccès", CodCry
   ElseIf CodCry <> CodAcc Then
      MsgBox "Accès dénié.", vbCritical, "Voir feuille": Exit Sub: End If
   Wsh.Visible = xlSheetVisible
   Wsh.Activate
   If UCase(Nom) = "ERIC" Then
      For Each Wsh In ThisWorkbook.Worksheets
         Wsh.Visible = xlSheetVisible: Next Wsh: End If
   End Sub
Function CodeCrypté(ByVal MdP As String) As Double
   Const NOr = (5 ^ 0.5 + 1) / 2: Dim Code#, P&, A#
   For P = 1 To Len(MdP): A = Asc(Mid$(MdP, P, 1)) / &H100
      Code = (Code + A) ^ 7 + NOr: Code = Code - Int(Code): Next P
   CodeCrypté = Int(Code * 1E+15)
   End Function
Sub MotDePasseOublié()
   If MsgBox("Êtes-vous sûr de vouloir supprimer le code d'accès de cette feuille ?", _
      vbYesNo + vbExclamation, "Mot de passe oublié") = vbNo Then Exit Sub
   On Error Resume Next
   ActiveSheet.Names("CodeDAccès").Delete
   End Sub