Microsoft 365 Aide pour code protection cellules non vides à la fermeture

lo-de · 5 Décembre 2023

Bonjour,

J'aimerai protéger les cellules d'un tableau à la fermeture du fichier.

J'ai fait un code pour la protection après saisie:

VB:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("MesureTransfere")) Is Nothing Then
        Me.Unprotect
        Target.Locked = True
        Me.Protect
    End If
End Sub

Mais je voudrais protéger les données qu'à la fermeture et non juste après la saisie, en laissant le tableau suivant accessible pour entrer les mesures.

Merci

lo-de · 5 Décembre 2023

A chaque fois il fois renommer le groupe de cellule ?

crocrocro · 5 Décembre 2023

Non, la macro s'appliquera à toutes les cellules de la plage nommée "MesureTransfere".
Si cela doit être étendu à d'autres cellules il faudra simplement les inclure dans la plage "MesureTransfere"
(Formules -> Gestionnaire des Noms -> sélectionner "MesureTransfere" ...

lo-de · 5 Décembre 2023

crocrocro à dit:
Non, la macro s'appliquera à toutes les cellules de la plage nommée "MesureTransfere".
Si cela doit être étendu à d'autres cellules il faudra simplement les inclure dans la plage "MesureTransfere"
(Formules -> Gestionnaire des Noms -> sélectionner "MesureTransfere" ...

Ok merci pour tout

lo-de · 6 Décembre 2023

Bonjour, j'ai un soucis lors de l'ouverture du fichier après fermeture, la feuille est verrouillée donc je peux entrer les mesures, les mesures précédentes sont verrouillées. Mais dès que je veux fermer il y a un soucis, je dois oter la protection pour que cela fonctionne.

lo-de · 6 Décembre 2023

lo-de à dit:
Bonjour, j'ai un soucis lors de l'ouverture du fichier après fermeture, la feuille est verrouillée donc je peux entrer les mesures, les mesures précédentes sont verrouillées. Mais dès que je veux fermer il y a un soucis, je dois oter la protection pour que cela fonctionne.

J'ai ajouté .unprotect pour déverouiller le temps de la macro:

VB:

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Dim MAJ As Boolean
    With Sheets("Feuil1")
        .Unprotect
            For Each cell In .Range("Mesure")
                Select Case True
                Case cell.Locked = False And Not (IsEmpty(cell))
                    cell.Locked = True
                Case cell.Locked = True And IsEmpty(cell)
                   cell.Locked = False
                End Select
            Next
            If Not (.ProtectContents) Then
                MAJ = False
                For Each cell In .Range("Mesure")
                    If cell.Locked = True Then
                        MAJ = True
                    End If
            Next
            If MAJ Then
                  .Protect
            End If
        End If
    End With

crocrocro · 6 Décembre 2023

Bonjour,
excusez mon erreur, voici la correction et de nouvelles remarques :
- l'état normal des cellules de la plage est
si cellule vide, elle est déverrouillée
si cellule non vide elle est verrouillée
Donc, à la fermeture du fichier,

on vérifie toutes les cellules de la plage et le cas échéant on rétablit le verrouillage / déverrouillage (on déprotège la feuille si une rectification de verrouillage est à faire)

Puis, si la feuille est déprotégée et s'il existe au moins une cellule de la plage verrouillée, on protège la feuille même si aucune rectification n'a été faite.

Pour pouvoir travailler sur la feuille,

sur les cellules vides, aucun problème que la feuille soit protégée ou non

sur les cellules non vides (ici blanc <> de vide), par exemple pour corriger une erreur de saisie, si la feuille est protégée, il faudra la déprotéger

VB:

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Dim MAJ As Boolean
    With Sheets("Feuil1")
        For Each cell In .Range("MesureTransfere")
            Select Case True
                Case cell.Locked = False And Not (IsEmpty(cell))
                    If .ProtectContents = False Then .Unprotect
                    cell.Locked = True
                Case cell.Locked = True And IsEmpty(cell)
                    If .ProtectContents = False Then .Unprotect
                    cell.Locked = False
            End Select
        Next
        If Not (.ProtectContents) Then
            MAJ = False
            For Each cell In .Range("MesureTransfere")
                If cell.Locked = True Then
                    MAJ = True
                End If
            Next
            If MAJ Then
                  .Protect
            End If
        End If
    End With
End Sub

lo-de · 6 Décembre 2023

Merci pour votre retour rapide.

Un dernière question si je veux faire sur plusieurs feuilles du même classeur, il faut ajouter les feuilles après With sheets= ("Feuil1")("Feuil2")("Feuil3")etc... ?
Biensur les cellules je les ajoute au range "MesureTransfere"

crocrocro · 6 Décembre 2023

lo-de à dit:
Merci pour votre retour rapide.

Un dernière question si je veux faire sur plusieurs feuilles du même classeur, il faut ajouter les feuilles après With sheets= ("Feuil1")("Feuil2")("Feuil3")etc... ?
Biensur les cellules je les ajoute au range "MesureTransfere"

Dans l'idée oui mais il faut ici dupliquer tout le pavé "With" "End With", les ajouter les uns au-dessous des autres en changeant simplement le nom de la feuille (et le nom du range si le nom est différent dans les autres feuilles)

Microsoft 365 Aide pour code protection cellules non vides à la fermeture

lo-de

XLDnaute Nouveau

Pièces jointes

lo-de

XLDnaute Nouveau

crocrocro

XLDnaute Impliqué

lo-de

XLDnaute Nouveau

lo-de

XLDnaute Nouveau

lo-de

XLDnaute Nouveau

crocrocro

XLDnaute Impliqué

lo-de

XLDnaute Nouveau

crocrocro

XLDnaute Impliqué

Discussions similaires