Autres [RESOLU]Verrouiller une cellule apres saisie avec un mot de passe

sergiofox

XLDnaute Junior
Bonjour, je suis novice et je voudrais faire une feuille de match qui se verrouille après saisie, j'ai trouvé différentes formules que j'ai essayé d'appliquer, elles fonctionnent tant que je n'y ajoute pas un mot de passe pour verrouiller la feuille, pourriez-vous m'aider ?
Merci d'avance.
1573308893439.png

1573308986775.png
 

Pièces jointes

  • test fichier feuille de match avec mot de passe.xlsm
    17.3 KB · Affichages: 8
  • test fichier feuille de match.xlsm
    17.1 KB · Affichages: 4

job75

XLDnaute Barbatruc
Bonjour sergiofox,

Voyez ce que donne le fichier joint avec cette macro :
VB:
Private Sub Worksheet_Change(ByVal Target As Range)
Protect "toto", UserInterfaceOnly:=True
Cells.Locked = False
On Error Resume Next
Cells.SpecialCells(xlCellTypeConstants).Locked = True
Cells.SpecialCells(xlCellTypeFormulas).Locked = True
End Sub
A+
 

Pièces jointes

  • test fichier feuille de match(1).xlsm
    19.5 KB · Affichages: 9

sergiofox

XLDnaute Junior
Bonjour sergiofox,

Voyez ce que donne le fichier joint avec cette macro :
VB:
Private Sub Worksheet_Change(ByVal Target As Range)
Protect "toto", UserInterfaceOnly:=True
Cells.Locked = False
On Error Resume Next
Cells.SpecialCells(xlCellTypeConstants).Locked = True
Cells.SpecialCells(xlCellTypeFormulas).Locked = True
End Sub
A+
Bonsoir,
Merci de votre aide mais où dois-je intégrer cette commande dans la mienne ?
Private Sub Worksheet_Change(ByVal Target As Range) 'au changement dans l'onglet

If test = True Then Exit Sub 'si test est vraie, sort de la procédure
If Selection.Cells.Count > 1 Then Exit Sub 'si la sélection contient plus d'une seule cellule, sort de la procédure
If Target.Value = "" Then Exit Sub 'si la cellule est effacée, sort de la procédure
'si le changement a lieu ailleurs que dans la plage A1:A10, sort de la procédure (tu adapteras à ton cas)
If Application.Intersect(Target, Range("Score1:Score10")) Is Nothing Then Exit Sub
test = True 'définit la variable test
'condition : si "oui" au message
If MsgBox("Validez-vous cette entrée ?", vbYesNo, "Attention !") = vbYes Then
ActiveSheet.Unprotect 'déprotège l'onglet
Target.Locked = True 'verrouille la cellule modifiée
ActiveSheet.Protect 'protège l'onglet
Else 'sinon
Target.Select 'sélectionne la cellule modifié
Target.ClearContents 'supprime le contenu de la cellule modifié (cette action relance la procédure d'où le test...)
End If 'fin de la condition
test = False 'redéfinit la variable test
End Sub
 

job75

XLDnaute Barbatruc
Bon OK par sécurité, fichier (2) avec :
VB:
Private Sub Worksheet_Change(ByVal Target As Range)
If MsgBox("Confirmez-vous ce que vous venez d'entrer ?", 4) = vbNo Then
    Application.EnableEvents = False
    Target = ""
    Application.EnableEvents = True
End If
Protect "toto", UserInterfaceOnly:=True
Cells.Locked = False
On Error Resume Next
Cells.SpecialCells(xlCellTypeConstants).Locked = True
Cells.SpecialCells(xlCellTypeFormulas).Locked = True
End Sub
 

Pièces jointes

  • test fichier feuille de match(2).xlsm
    20.3 KB · Affichages: 13

Eric C

XLDnaute Barbatruc
Bonsoir le forum
Bonsoir sergiofox, job75

Alors là, moi je suis largué..... J'ai beau cherché et recherché... je ne trouve pas de range ???? ni de constantes ni de formules ??? Pourrais tu, s'il te plait, monsieur job75 me développer (voire me décortiquer) cette macro.
Bonne soirée
@+ Eric c
 

Eric C

XLDnaute Barbatruc
Merci job75. Je faisais référence au post (#2) où il n'y a pas de réponse à fournir ?
Donc, je vais tenter d'approfondir la propriété Locked et voir pour le formatage des cellules .
C'est bien une des premières fois où je ne vois pas une plage ("F3:G13") être déclarée ??
Bonne soirée
 

job75

XLDnaute Barbatruc
Avec Application.Undo c'est mieux car on revient sur la sélection de l'entrée, voyez ce fichier (3) :
VB:
Private Sub Worksheet_Change(ByVal Target As Range)
If MsgBox("Confirmez-vous ce que vous venez d'entrer ?", 4) = vbNo Then
    Application.EnableEvents = False
    Application.Undo 'annule l'entrée
    Application.EnableEvents = True
End If
Protect "toto", UserInterfaceOnly:=True
Cells.Locked = False
On Error Resume Next 'si aucune SpecialCell
Cells.SpecialCells(xlCellTypeConstants).Locked = True
Cells.SpecialCells(xlCellTypeFormulas).Locked = True
End Sub
 

Pièces jointes

  • test fichier feuille de match(3).xlsm
    20.5 KB · Affichages: 13

Discussions similaires

Statistiques des forums

Discussions
311 724
Messages
2 081 936
Membres
101 844
dernier inscrit
pktla