Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim tablo1, tablo2, i As Byte
tablo1 = Array([G:G], [I:I], [K:K], [M:M]) 'plages protégées
tablo2 = Array("tata", "titi", "toto", "tutu") 'mots de passe
For i = 0 To UBound(tablo1)
If Not Intersect(Target, tablo1(i)) Is Nothing Then
If InputBox("Mot de passe") <> tablo2(i) Then _
[A1].Select: Exit Sub
End If
Next
End Sub
Bonjour adkheir,
Par exemple cette macro dans le code de la feuille (clic droit sur l'onglet et Visualiser le code) :
Fichier joint.Code:Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim tablo1, tablo2, i As Byte tablo1 = Array([G:G], [I:I], [K:K], [M:M]) 'plages protégées tablo2 = Array("tata", "titi", "toto", "tutu") 'mots de passe For i = 0 To UBound(tablo1) If Not Intersect(Target, tablo1(i)) Is Nothing Then If InputBox("Mot de passe") <> tablo2(i) Then _ [A1].Select: Exit Sub End If Next End Sub
Nota 1 : encore faut-il que les macros soient activées, cherchez sur le forum.
Nota 2 : possible de cacher les caractères tapés dans l'InputBox, bis repetita : cherchez.
Edit : ajouté Exit Sub
A+
seulement c'est embarrassant de rentrer le mot de passe pour chaque cellule !! , une fois normalement ça doit être très suffisant
Option Explicit
Dim bon(255) As Boolean 'mémorise le tableau (max 256 éléments)
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim tablo1, tablo2, i As Byte
tablo1 = Array([G:G], [I:I], [K:K], [M:M]) 'plages protégées
tablo2 = Array("tata", "titi", "toto", "tutu") 'mots de passe
For i = 0 To UBound(tablo1)
If Not (Intersect(Target, tablo1(i)) Is Nothing Or bon(i)) Then
If InputBox("Mot de passe :", "Plage " & tablo1(i).Address(0, 0)) = tablo2(i) Then
bon(i) = True
Else
[A1].Select
Exit Sub
End If
End If
Next
End Sub
Option Explicit
Dim bon(255) As String 'mémorise le tableau (max 256 éléments)
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim tablo1, tablo2, i As Byte
tablo1 = Array([G:G], [I:I], [K:K], [M:M]) 'plages protégées
tablo2 = Array("tata", "titi", "toto", "tutu") 'mots de passe
For i = 0 To UBound(tablo1)
If Not Intersect(Target, tablo1(i)) Is Nothing And bon(i) <> Environ("Username") Then
If InputBox("Mot de passe :", "Plage " & tablo1(i).Address(0, 0)) = tablo2(i) Then
bon(i) = Environ("Username")
Else
[A1].Select
Exit Sub
End If
End If
Next
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim tablo1, tablo2, i As Byte
tablo1 = Array([G:G], [I:I], [K:K], [M:M]) 'plages protégées
tablo2 = Array("Gérard", "adkheir", "zozo", "zuzu") 'noms utilisateurs
For i = 0 To UBound(tablo1)
If Not Intersect(Target, tablo1(i)) Is Nothing And _
Environ("Username") <> tablo2(i) Then [A1].Select: Exit Sub
Next
End Sub
'pour connaître le nom utilisateur lancer cette macro :
Sub Nom()
MsgBox Environ("Username")
End Sub
Private Sub Workbook_Open()
'remet à zéro la mémorisation
Dim bon(255) As String
ThisWorkbook.Names.Add "memo", bon 'définit le nom
ThisWorkbook.Names("memo").Visible = False 'masque le nom
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim tablo1, tablo2, i As Byte, bon(255) As String
tablo1 = Array([G:G], [I:I], [K:K], [M:M]) 'plages protégées
tablo2 = Array("tata", "titi", "toto", "tutu") 'mots de passe
For i = 0 To UBound(tablo1)
bon(i) = Application.Index([memo], i + 1)
Next
For i = 0 To UBound(tablo1)
If Not Intersect(Target, tablo1(i)) Is Nothing And bon(i) <> Environ("Username") Then
If InputBox("Mot de passe :", "Plage " & tablo1(i).Address(0, 0)) = tablo2(i) Then
bon(i) = Environ("Username")
ThisWorkbook.Names.Add "memo", bon 'définit le nom
ThisWorkbook.Names("memo").Visible = False 'masque le nom
Else
[A1].Select
Exit Sub
End If
End If
Next
End Sub