VBA protéger des cellules en fonction du numéro de ligne

[LPandre]

Bonjour, je souhaiterais un code VBA pour que dans un tableau de hauteur variable, toutes les lignes du tableau multiple de 4 soit verrouillées par mot de passe.
Dans le fichier joint ce serait les lignes 4,8 et 12 par exemple.

Par avance merci.

 

[job75]

Bonjour LPandre,

Voyez le fichier joint et ces 2 macros dans ThisWorkbook et dans le code de la feuille :

Private Sub Workbook_Open()
On Error Resume Next 'si la feuille est masquée
Application.Goto Feuil1.[A1], True
End Sub

Dim autorise As Boolean 'mémorise la variable

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim r As Range
Set r = Intersect(Target.EntireRow, Me.UsedRange.EntireRow)
If r Is Nothing Or autorise Then Exit Sub
For Each r In r.Rows 'si sélection multiple
  If r.Row Mod 4 = 0 Then
    If InputBox("Entrez le mot de passse :", "Mot de passe") <> "toto" Then [A1].Select Else autorise = True
    Exit For
  End If
Next
End Sub

La variable mémorisée autorise évite d'avoir à entrer à chaque fois le mot de passe s'il a été entré avec succès.

Bien sûr il faut que les macros aient été activées...

A+

 

[job75]

Re,

Cela dit le critère "toutes les lignes du tableau multiple de 4" n'est guère fameux.

En effet il suffit d'insérer une ligne au-dessus de la ligne 1 pour pouvoir accéder aux lignes interdites, et de la supprimer ensuite.

Ce fichier (2) et cette macro me paraissent plus acceptables :

Dim autorise As Boolean 'mémorise la variable

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim r As Range
Set r = Intersect(Target.EntireRow, Me.UsedRange.EntireRow)
If r Is Nothing Or autorise Then Exit Sub
For Each r In r.Rows 'si sélection multiple
  If IsNumeric(CStr(r.Cells(1))) Then
    If InputBox("Entrez le mot de passse :", "Mot de passe") <> "toto" Then [A1].Select Else autorise = True
    Exit For
  End If
Next
End Sub

A+

 

[job75]

Re,

Bon le fichier (2) n'est pas forcément la bonne solution...

Avec ce fichier (3) je reviens à la 1ère solution mais en protégeant la feuille (même mot de passe).

C'est à vous de mieux préciser votre besoin.

A+

 

[job75]

Bonjour LPandre, le forum,

Fichier (4) avec un UserForm.

J'ai complété la macro en contrôlant les sélections au-dessous du UsedRange :

Dim autorise As Boolean 'mémorise la variable

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If autorise Then Exit Sub
Dim derlig&, r As Range
derlig = Me.UsedRange.Row + Me.UsedRange.Rows.Count - 1
For Each r In Target.EntireRow.Rows 'si sélection multiple
  If r.Row Mod 4 = 0 Or r.Row > derlig Then
    UserForm1.Show
    autorise = ActiveCell.Row > 1
    Exit For
  End If
Next
End Sub

Bonne journée.

 

[LPandre]

Merci beaucoup job75. A voir les solutions je me rends compte mettre mal exprimé. Ce que je souhaite est plus simple :
Le "blocage" des lignes 4 et multiples doit être automatique : je lance la macro 1 seule fois et c'est bloqué.

L'utilisateur n'a pas la possibilité de modifier cet état : pas de user form pour l'inviter à entrer le mot de passe.
Seul le passage par les menus Excel de protection pourront permettre de débloquer.
J'espère être plus clair;

 

[job75]

Re,

Ce que je souhaite est plus simple :
Le "blocage" des lignes 4 et multiples doit être automatique : je lance la macro 1 seule fois et c'est bloqué.

Dans ce cas le VBA est inutile, voyez le fichier joint.

Mais je subodore que vous n'avez pas tout dit...

A+

 

[LPandre]

Je vais essayer d'être plus précis avec ce code que je viens de faire enregistrer par Excel :
j'ai mis mes questions/remarques dérière les '

Sub Macro10()
Sheets("Feuil1").Select
Cells.Select
Selection.Locked = False
Selection.FormulaHidden = False
Range("4:4,8:8,12:12,16:16,20:20,24:24,28:28,32:32").Select
'par rapport à la ligne ci dessus, plutôt que de devoir renseigner toutes les lignes multiples de 4 qui seraient alimentées dans 'le tableau je préférerais une boucle qui le fasse.
'Avec peut être un code du genre :
'Dim L As Long
' L = Range("A65536").End(xlUp).Row
' puis le code me prends toutes les lignes multiples de 4 et ensuite :

Selection.Locked = True
Selection.FormulaHidden = False 'ça je ne sais pas ce que cela veut dire l'enregistreur me le colle d'office
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
' comment imposer le mot de passe "Toto" dans l'éxécution de la macro ?
Range("A1").Select
End Sub


Est ce plus explicite ?

 

[job75]

Re,

Vous croyez que verrouiller les cellules 4-8-12 etc... est le vrai problème ???

Dans ce cas il n'y a vraiment pas besoin de macro :

- vérifier d'abord que toutes les cellules de la feuille sont verrouillées (Format de cellule => Protection)

- sélectionner les 3 lignes 5:7 et déverrouiller leurs cellules

- Copier-Collage spécial-Formats des 4 lignes 5:8 sur les 996 lignes 5:1000 (ou 5:10000)

- protéger la feuille avec mot de passe.

Mais je pense que le vrai problème est plus compliqué : il consiste à déverrouiller les cellules en fonction de chaque utilisateur.

Voyez ce fichier (5) et les macros dans ThisWorkbook, UserForm1 et Module1.

Les Identifiants et Mots de passe sont stockés dans la TextBox3 sous la forme -BENJI*123-GERARD*456-PAUL*789-

les mots de passe pour les 3 utilisateurs BENJI-GERARD-PAUL étant 123-456-789.

Ne pas oublier les tirets au début et à la fin de la chaîne de caractères.

Un point important à noter : grâce à la macro Workbook_BeforeSave cela n'a aucune importance si l'utilisateur n'active pas les macros.

Il ne pourra tout simplement pas modifier la feuille.

A+

 

[job75]

Bonjour LPandre, le forum,

Je viens d'améliorer nettement la cohérence des codes du fichier (5) précédent.

Bonne journée.

 

[job75]

Re,

Fichier (5 bis) si l'on veut afficher uniquement ce qui concerne l'utilisateur.

A+

 

[job75]

Bonjour le forum,

Aux abonnés absents LPandre ?

Pour terminer voici un fichier complet qui permet de traiter toutes les semaines de 2017.

Formule en A1 : pour le numéro de semaine je n'utilise pas NO.SEMAINE.ISO(C3) qui n'existe pas sur Excel 2003.

En ligne 3 j'utilise des formats dates personnalisés afin que la 1ère lettre du jour soit en majuscule.

Bon dimanche.

 

[LPandre]

Réponse rapide : j'ai été quelque peu débordé ces derniers temps.
Merci pour le temps passé. Je vais tester tout ça dès que j'ai 5mn "tranquilles" !

 

[LPandre]

J'ai profité du passage d'un presta pour lui poser la question, et il m'a fait ce code qui va bien.

Sub Proteger()
Dim I, pas_fini
I = 1
pas_fini = True
Dim MdP As String
ActiveSheet.Unprotect
While (pas_fini)
If (Left(Cells(I, 1).Value, 13) = "RECAPITULATIF") Then
I = I + 4
With Range(Cells(I, 3), Cells(I + 2, 9))
.Locked = False
With .Interior
.ColorIndex = 0
.Pattern = xlSolid
End With
End With
I = I + 4
'MsgBox ("tit " & i)
Else
If (Left(Cells(I, 2).Value, 11) = "Heure début") Then
With Range(Cells(I, 3), Cells(I + 2, 9))
.Locked = False
With .Interior
.ColorIndex = 0
.Pattern = xlSolid
End With
End With
I = I + 4
Else
pas_fini = False
End If
End If
Wend
MdP = "PRESSTALIS"
ActiveSheet.Protect MdP, DrawingObjects:=True, Contents:=True, Scenarios:=True
End Sub

J'ai pas tout compris, mais ça marche. Alors si ça peut être utile à d'autre(s)...

 

[job75]

Bis repetita pour les durs de la feuille :

Re,

Vous croyez que verrouiller les cellules 4-8-12 etc... est le vrai problème ???

Dans ce cas il n'y a vraiment pas besoin de macro