XL 2013 Bloquer une cellule avec un mdp après plusieurs essai

Ic0ne1300 · 22 Décembre 2020

Bonjour à tous !

Je reviens vers vous pour un nouveau soucis, en effet j'aimerai que pour certaine cellule, lorsque l'utilisateur veut rentrer une valeur, il ai que deux essais.
Si les valeurs rentrées ne sont toujours pas bonne au deuxième essai, il faudrait qu'un messagebox bloque excel et demande un mot de passe pour pouvoir débloquer le fichier et que l'utilisateur puisse continué à remplir le formulaire tout en ayant la mauvaise valeur. Le but est que l'utilisateur soit obliger d'avertir quelqu'un qu'il y a une erreur de valeur pour être débloquer par un supérieur. La case contenant la mauvaise valeur restera d'une couleur orange même après le blocage excel.

Si cela vous semble impossible, auriez vous d'autre solution ?

J'espère que mon besoin est bien expliqué

Merci d'avance de votre aide

Staple1600 · 22 Décembre 2020

Bonjour

Pourquoi ne pas simplement utiliser Données/Validation ?
• qui permet (entre autre chose) de restreindre la saisie aux seules valeurs autorisées.
(cf ce tutoriel de la Maison Mère)

sylvanu · 22 Décembre 2020

Bonjour Icone, Staple,
Juste un essai en PJ en utilisant :

Code:

Public NbFois%
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    On Error GoTo Fin
    If Target.Count > 1 Then Exit Sub
    If Not Intersect(Target, Range("C8")) Is Nothing Then
        [D15] = 0
        If Target <> "essai" Then
            NbFois = NbFois + 1: [D15] = NbFois
            If NbFois > 2 Then
                [C8].Interior.Color = RGB(255, 200, 0)
                resultat = InputBox("2 tentatives infructueuses." & Chr(10) & _
                            "Veuillez entrer le mot de passe de déverrouillage.", "Demande de levée de sécurité")
                If resultat = "mdp" Then
                    [C8].Interior.Color = vbWhite
                    NbFois = 0
                End If
            End If
        Else
            [C8].Interior.Color = vbWhite
            NbFois = 0
        End If
    End If
Fin:
End Sub

Ic0ne1300 · 23 Décembre 2020

Staple1600 à dit:
Bonjour

Pourquoi ne pas simplement utiliser Données/Validation ?
• qui permet (entre autre chose) de restreindre la saisie aux seules valeurs autorisées.
(cf ce tutoriel de la Maison Mère)

Bonjour Staple, et bien je ne peux pas utiliser les données de validation non seulement parce qu'elle ne me permettent pas d'avoir un mdp comme voulu, mais en plus elle ne me permet pas d'avoir la traçabilité de la mauvaise valeur rentré par l'utilisateur...

sylvanu à dit:
Bonjour Icone, Staple,
Juste un essai en PJ en utilisant :

Merci, c'est exactement ca ! En l'occurence tu as mis un mot pour le mot reconnu, étant donné que dans ma cellule l'utilisateur doit rentrer comme valeur les mesures qu'il effectue sur un appareil, donc la valeur doit être comprise entre un certain nombre décimal et un autre pour être considérée comme correct, ce ne sont pas des valeurs exactes, comment je peux remplacer ça dans le code stp ?
Et de plus, j'ai plusieurs cellule a bloquer, ca veut dire que je dois écrire à chaque fois le code ou il y a un moyen de noter toutes les cellules dans le même code, sachant que la tranche de valeur possible est différente pour chaque cellule ?

sylvanu · 23 Décembre 2020

Bonjour,
En PJ un essai avec deux valeurs min, max :

VB:

Sub Worksheet_Change(ByVal Target As Range)
    On Error GoTo Fin
    If Target.Count > 1 Then Exit Sub
    If Not Intersect(Target, Range("C8")) Is Nothing Then
        Vmin = 1.234    ' Valeur min correcte, à modifier
        Vmax = 3.456    ' Valeur max correcte, à modifier
        If Target < Vmin Or Target > Vmax Then
            MsgBox "Valeur non valide. Doit être comprise entre " & Vmin & " et " & Vmax
            NbFois = NbFois + 1
            If NbFois > 2 Then
                Target.Interior.Color = RGB(255, 200, 0)
                resultat = InputBox("2 tentatives infructueuses." & Chr(10) & _
                            "Veuillez entrer le mot de passe de dévérouillage.", "Demande de levée de sécurité")
                If resultat = "mdp" Then
                    Target.Interior.Color = vbWhite
                    NbFois = 0
                    Target = ""
                End If
            End If
        Else
            Target.Interior.Color = vbWhite
            NbFois = 0
        End If
    End If
Fin:
End Sub

S'il y a peu de cellules, le plus simple est de dupliquer la macro.
Si le nombre de cellules est important alors il faut changer de stratégie.
Je suppose que la sécurité de deux essais est valable pour chaque cellule ?
Donc il faudra mémoriser le nombre d'essais ratés pour chaque cellule. Surement en passant par un array.

sylvanu · 23 Décembre 2020

Re,
J'ai essayé une maquette si le nombre de cellules étaient élevées. C'est un peu plus complexe. Voir PJ.
1- J'utilise un array où sont stockées Adresse,Vmin,Vmax,compteur d'erreur. 4 éléments par cellule.
2- Un module Workbook_Open qui initialise ce tableau qui est en Public.
3- une seule macro Worksheet_Change qui analyse la cellule cliquée et mémorise par cellule les erreurs.

Ic0ne1300 · 23 Décembre 2020

Ok super merci tout marche pour le moment ! Une dernière chose, est-ce que c'est possible d'enlever le bouton "annuler" du inputbox, puisque si la personne appuie dessus le mdp ne sert pas vraiment....

Ic0ne1300 · 23 Décembre 2020

Ah oui et aussi, après qu'on est mis le mot de passe, la valeur se supprimer alors que j'aimerai qu'elle reste...

sylvanu · 23 Décembre 2020

Là, c'est verrouillé.

Ic0ne1300 · 29 Décembre 2020

Je te remercie ! Ton programme est nickel, malheureusement je n'arrive pas à l'adapter sur mon fichier... Je vais retravailler ça

sylvanu · 29 Décembre 2020

Bonjour Icone,
Si votre fichier n'est pas confidentiel ni trop volumineux, alors postez le on l'adaptera. Ou alors faites un fichier représentatif, juste avec ce qu'il faut pour que vous puissiez retranscrire cette macro dans votre fichier sans trop de problème.

XL 2013 Bloquer une cellule avec un mdp après plusieurs essai

Ic0ne1300

XLDnaute Nouveau

Staple1600

XLDnaute Barbatruc

sylvanu

XLDnaute Barbatruc

Pièces jointes

Ic0ne1300

XLDnaute Nouveau

sylvanu

XLDnaute Barbatruc

Pièces jointes

sylvanu

XLDnaute Barbatruc

Pièces jointes

Ic0ne1300

XLDnaute Nouveau

Ic0ne1300

XLDnaute Nouveau

sylvanu

XLDnaute Barbatruc

Pièces jointes

Ic0ne1300

XLDnaute Nouveau

sylvanu

XLDnaute Barbatruc

Discussions similaires