protection de plusieurs cellules avec mot de passe Résolu/Fermé

Question

Bonjour,

Je cherche partout (pas assez peut-être...) mais je ne trouve pas de solution à mon problème (pas fort en VBA).

le voici :

J'ai un fichier excel en mode partagé, et je veux interdire (dans certaines cases) l'écriture de certaines lettres.

En gros dans les cases allant de B2 à F12 ET dans les cases allant de B15 à F25 :
- "p", "m", "l" et "o" doivent avoir un mot de passe pour être écrit
- "d" peut l'être sans mot de passe

QQ un aurait une solution en VBA pour ceci ?

Sachant qu'en plus les personnes qui utilisent ce fichier peut faire du copie coller (ou tirer la cellule pour la recopier) 

Merci d'avance

Mike-31 · Answer

Bonsoir,

la je n'ai pas le temps, mais un début de code ou il faut remplacer le MSGBOX par une INPUTBOX

code à placer dans les propriétés de la feuille, clic droit sur l'onglet de la feuille concernée/Visualiser le code

Private Sub Worksheet_Change(ByVal Target As Range)
Set isect = Application.Intersect(Target, Union([B2:F12], [B15:F25]))
If Not isect Is Nothing Then
  If InStr(1, Target, "p") Or InStr(1, Target, "m") Or InStr(1, Target, "i") Or InStr(1, Target, "o") Then
   Target = ""
  MsgBox "cette saisie est interdite"
End If
End If
End Sub 
 
A+
Mike-31

Une période d'échec est un moment rêvé pour semer les graines du savoir.

i10 · Answer

merci de ce début de réponse rapide.

J'ai essayé le code :
- les lettres "p", "m", "l" et "o" sont bien verrouillé à l'écriture (mais j'aimerai pouvoir les écrire avec MDP, je sais que vous avez dit en début de post de créer une INPUTBOX ....mais je ne sais faire avec le MDP en plus)
- j'ai aussi tenté d'inscrire "m" en B2 et de tirer la case jusqu'en B10: le message d'interdiction apparait bien et efface en B2 le "m", mais de B3 à B4 les "m" copié reste dans les cases.


merci

Mike-31 · Answer

Re,

remplace l'ancien code par celui ci et le mot de passe est titi

Private Sub Worksheet_Change(ByVal Target As Range)
Set isect = Application.Intersect(Target, Union([B2:F12], [B15:F25]))
If Not isect Is Nothing Then
  If InStr(1, Target, "p") Or InStr(1, Target, "m") Or InStr(1, Target, "i") Or InStr(1, Target, "o") Then
  Dim resultat As String
    resultat = InputBox("Veuillez saisir votre mot de passe !", "Saisie réglementée")
    If resultat <> "titi" Then
     Target = ""
     MsgBox "Votre saisie a été refusée"
     Target.Select
    End If
End If
End If
End Sub
 

afin que nous parlions le même langage, que veux tu dire par "j'aimerai pouvoir les écrire avec MDP" 
A+
Mike-31

Une période d'échec est un moment rêvé pour semer les graines du savoir.

i10 · Answer

Super ça marche bien avec le MDP .

Par contre j'ai une erreur d'exécution 13 lorsque je "tire" une case ou il y avait "m" (tire = souris en bas à droite de la case, clic gauche + tirer pour fair eun copier coller sur plusieurs cases adjacentes)

sinon impec

Mike-31 · Answer

Re,

je ne pensais pas que tu voulais en plus incrémenter, remple le code précédent par celui ci

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
Set isect = Application.Intersect(Target, Union([B2:F12], [B15:F25]))
If Not isect Is Nothing Then
If InStr(1, Target, "p") Or InStr(1, Target, "m") Or InStr(1, Target, "i") Or InStr(1, Target, "o") Then
Dim resultat As String
resultat = InputBox("Veuillez saisir votre mot de passe !", "Saisie réglementée")
If resultat <> "titi" Then
Target = ""
MsgBox "Votre saisie a été refusée"
Target.Select
End If
End If
End If
End Sub

i10 · Answer

Trop fort 

Mes respects 

Tout fonctionne bien

Grand merci

Mike-31 · Answer

Re,

Alors je passe le statut de la discussion en résolu, mais rien ne t'empêche d'y revenir

i10 · Answer

J'aurais encore une question....

Et si au lieu de ne verrouiller que certaines lettres de l'alphabet, je souhaitais dérouiller toutes les lettres de la même manière ? 

Je pense qu'il doit y avoir une astuce sur cette commande "If InStr(1, Target, "p") Or InStr(1, Target, "m") Or InStr(1, Target, "i") Or InStr(1, Target, "o") Then " plutôt que se réécrire toutes les lettres .

Cordialement

Protection de plusieurs cellules avec mot de passe

8 réponses