Revenir sur Inputbox en cas d'erreur

  • Initiateur de la discussion Initiateur de la discussion Chris401
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

Chris401

XLDnaute Accro
Bonsoir

Dans le fichier joint, plusieurs feuilles construites sur une base identique.

A l'activation d'une feuille, une Inputbox demande un MDP ; selon le MDP inscrit, certaines colonnes s'affichent.
Code:
Const MDP As String = "Admin"
Const Masque1 As String = "MDP1"
Const Masque2 As String = "MDP2"
Const Masque3 As String = "MDP3"

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
ActiveSheet.Unprotect MDP

Range("F1:IV1").Columns.Hidden = True

Application.ScreenUpdating = False
Dim Col As Byte

    rep = InputBox("Veuillez Saisir Votre Mot de Passe", "MOT DE PASSE", "mot de passe")

        If rep = "" Then
        ActiveSheet.Protect MDP
        End
        End If
        
        If rep = MDP Then
            Range("F1:Q1").Columns.Hidden = False
        Else
        If rep = Masque1 Then Col = 6
        If rep = Masque2 Then Col = 10
        If rep = Masque3 Then Col = 14

        If Col = 0 Then
            MsgBox "Erreur Mot de Passe"
            ActiveSheet.Protect MDP
            End
        End If

            Range(Cells(1, Col), Cells(1, Col + 3)).Columns.Hidden = False
        End If

ActiveSheet.Protect MDP
End Sub

Et à la fermeture du classeur
Code:
Private Sub Workbook_BeforeClose(Cancel As Boolean)
ActiveSheet.Unprotect MDP
Range("F1:IV1").Columns.Hidden = True
End Sub

Tout ça fonctionne mais ce que je voudrais modifier c'est que si le MDP est faux (Col = 0) l'utilisateur puisse entrer un nouveau MDP. Pour l'instant on est obligé de quitter la feuille en cours et d'y revenir.

P.S. : toute optimisation du code actuel est la bienvenue.

Merci
Cordialement
Chris
 

Pièces jointes

Re : Revenir sur Inputbox en cas d'erreur

Re,
voici le code si j'ai bien compris
Code:
ActiveSheet.Unprotect MDP

Range("F1:IV1").Columns.Hidden = True

Application.ScreenUpdating = False
Dim Col As Byte
ici:
    rep = InputBox("Veuillez Saisir Votre Mot de Passe", "MOT DE PASSE", "mot de passe")

        If rep = "" Then
        ActiveSheet.Protect MDP
        End
        End If
        
        If rep = MDP Then
            Range("F1:Q1").Columns.Hidden = False
        Else
        If rep = Masque1 Then Col = 6
        If rep = Masque2 Then Col = 10
        If rep = Masque3 Then Col = 14

        If Col = 0 Then
            MsgBox "Erreur Mot de Passe"
            ActiveSheet.Protect MDP
            GoTo ici
            End
        End If

            Range(Cells(1, Col), Cells(1, Col + 3)).Columns.Hidden = False
        End If

ActiveSheet.Protect MDP
End Sub
A+
 
Re : Revenir sur Inputbox en cas d'erreur

Bonjour à tous.


Une autre solution, sans GoTo :​
VB:
Const MDP As String = "Admin"
Const Masque1 As String = "MDP1"
Const Masque2 As String = "MDP2"
Const Masque3 As String = "MDP3"

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Dim Col As Byte, msg0$, msg1$, rep$

    With Sh

        .Unprotect MDP
        .Columns("F:Q").Hidden = True
        .Protect MDP

        Application.ScreenUpdating = False
        msg1 = "Veuillez saisir votre mot de passe : "

        Do
            rep = InputBox(msg0 & msg1, "MOT DE PASSE", "mot de passe")
            Select Case rep
            Case "": End
            Case MDP: Col = 1
            Case Masque1: Col = 6
            Case Masque2: Col = 10
            Case Masque3: Col = 14
            Case Else: msg0 = "Mot de passe erroné !" & vbLf & vbLf
            End Select
        Loop Until Col

        .Unprotect MDP
        Select Case Col
        Case 1: .Columns("F:Q").Hidden = False
        Case 6, 10, 14: .Columns(Col).Resize(, 3).Hidden = False
        End Select
        .Protect MDP

    End With

End Sub


Bonne nuit.


ℝOGER2327
#7293


Mercredi 11 Palotin 141 (Explosion du Palotin - Vacuation)
11 Floréal An CCXXII, 0,9868h - rhubarbe
2014-W18-3T02:22:06Z
 

Pièces jointes

Dernière édition:
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
16
Affichages
1 K
  • Question Question
XL 2021 VBA excel
Réponses
4
Affichages
171
Réponses
4
Affichages
177
Réponses
4
Affichages
223
Réponses
1
Affichages
496
Réponses
2
Affichages
153
Retour