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

LPandre

XLDnaute Impliqué
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.
 

Pièces jointes

  • Site1.zip
    4.7 KB · Affichages: 34

job75

XLDnaute Barbatruc
Bonjour LPandre,

Voyez le fichier joint et ces 2 macros dans ThisWorkbook et dans le code de la feuille :
Code:
Private Sub Workbook_Open()
On Error Resume Next 'si la feuille est masquée
Application.Goto Feuil1.[A1], True
End Sub
Code:
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+
 

Pièces jointes

  • Site(1).xls
    61.5 KB · Affichages: 35

job75

XLDnaute Barbatruc
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 :
Code:
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+
 

Pièces jointes

  • Site(2).xls
    61.5 KB · Affichages: 37

job75

XLDnaute Barbatruc
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+
 

Pièces jointes

  • Site(3).xls
    61.5 KB · Affichages: 37

job75

XLDnaute Barbatruc
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 :
Code:
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.
 

Pièces jointes

  • Site(4).xls
    70 KB · Affichages: 38

LPandre

XLDnaute Impliqué
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;
 

LPandre

XLDnaute Impliqué
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

XLDnaute Barbatruc
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+
 

Pièces jointes

  • Site(5).xls
    84 KB · Affichages: 43
Dernière édition:

job75

XLDnaute Barbatruc
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.
 

Pièces jointes

  • Semaines 2017(1).xls
    74 KB · Affichages: 44

LPandre

XLDnaute Impliqué
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)...
 

Discussions similaires

Statistiques des forums

Discussions
312 814
Messages
2 092 339
Membres
105 374
dernier inscrit
kjk