XL 2013 Vérrouillage des cellules remplies à l'enregistrement pour le Classeur entier

  • Initiateur de la discussion Initiateur de la discussion MrThity
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

MrThity

XLDnaute Nouveau
Bonjour, je préviens avant tout, je n'y connais rien en VBA, mais je fais mes petites recherches et je trouve des solutions.
Mais là je suis coincé

Le Code suivant permet de verrouiller une cellule après avoir enregistrer le document Excel, mais le code ne fonctionne que pour une Feuille, feuille dont je ne peux pas changer le nom automatiquement,
Si quelqu'un pouvait corriger ce problème pour moi, ce serait cool !!

Private Sub WorkSheet_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

ActiveSheet.Unprotect Password:="123"
For Each C In Sheets("Feuil1").Range("A1:Z1000")
If C <> "" Then
If C.MergeCells Then
C.MergeArea.Locked = True
Else
C.Locked = True
End If
End If
Next
ActiveSheet.Protect Password:="123", DrawingObjects:=False, Contents:=True, Scenarios:= _
False, AllowFormattingCells:=True, AllowFormattingColumns:=True, _
AllowFormattingRows:=True, AllowInsertingColumns:=True, AllowInsertingRows _
:=True, AllowInsertingHyperlinks:=True, AllowDeletingColumns:=True, _
AllowDeletingRows:=True, AllowSorting:=True, AllowFiltering:=True, _
AllowUsingPivotTables:=True
ActiveSheet.EnableSelection = xlNoRestrictions
End Sub


Ce code fonctionne très bien mais uniquement sur une seule feuille nommée "feuil1"
 
Bonjour, je préviens avant tout, je n'y connais rien en VBA, mais je fais mes petites recherches et je trouve des solutions.
Mais là je suis coincé

Le Code suivant permet de verrouiller une cellule après avoir enregistrer le document Excel, mais le code ne fonctionne que pour une Feuille, feuille dont je ne peux pas changer le nom automatiquement,
Si quelqu'un pouvait corriger ce problème pour moi, ce serait cool !!

Private Sub WorkSheet_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

ActiveSheet.Unprotect Password:="123"
For Each C In Sheets("Feuil1").Range("A1:Z1000")
If C <> "" Then
If C.MergeCells Then
C.MergeArea.Locked = True
Else
C.Locked = True
End If
End If
Next
ActiveSheet.Protect Password:="123", DrawingObjects:=False, Contents:=True, Scenarios:= _
False, AllowFormattingCells:=True, AllowFormattingColumns:=True, _
AllowFormattingRows:=True, AllowInsertingColumns:=True, AllowInsertingRows _
:=True, AllowInsertingHyperlinks:=True, AllowDeletingColumns:=True, _
AllowDeletingRows:=True, AllowSorting:=True, AllowFiltering:=True, _
AllowUsingPivotTables:=True
ActiveSheet.EnableSelection = xlNoRestrictions
End Sub


Ce code fonctionne très bien mais uniquement sur une seule feuille nommée "feuil1"
Bonsoir,
A tester comme ceci
VB:
Private Sub WorkSheet_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Dim C As Range, Sh As Worksheet
    For Each Sh In Worksheets
        Sh.Unprotect Password:="123"
        Sh.Cells.Locked = False
        For Each C In Sh.Range("A1:Z1000")
            If C <> "" Then
                If C.MergeCells Then
                    C.MergeArea.Locked = True
                Else
                    C.Locked = True
                End If
            End If
        Next
        Sh.Protect Password:="123", DrawingObjects:=False, Contents:=True, Scenarios:= _
                   False, AllowFormattingCells:=True, AllowFormattingColumns:=True, _
                   AllowFormattingRows:=True, AllowInsertingColumns:=True, AllowInsertingRows _
                   :=True, AllowInsertingHyperlinks:=True, AllowDeletingColumns:=True, _
                   AllowDeletingRows:=True, AllowSorting:=True, AllowFiltering:=True, _
                   AllowUsingPivotTables:=True
        Sh.EnableSelection = xlNoRestrictions
    Next
End Sub
 
Bonsoir,
A tester comme ceci
VB:
Private Sub WorkSheet_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Dim C As Range, Sh As Worksheet
    For Each Sh In Worksheets
        Sh.Unprotect Password:="123"
        Sh.Cells.Locked = False
        For Each C In Sh.Range("A1:Z1000")
            If C <> "" Then
                If C.MergeCells Then
                    C.MergeArea.Locked = True
                Else
                    C.Locked = True
                End If
            End If
        Next
        Sh.Protect Password:="123", DrawingObjects:=False, Contents:=True, Scenarios:= _
                   False, AllowFormattingCells:=True, AllowFormattingColumns:=True, _
                   AllowFormattingRows:=True, AllowInsertingColumns:=True, AllowInsertingRows _
                   :=True, AllowInsertingHyperlinks:=True, AllowDeletingColumns:=True, _
                   AllowDeletingRows:=True, AllowSorting:=True, AllowFiltering:=True, _
                   AllowUsingPivotTables:=True
        Sh.EnableSelection = xlNoRestrictions
    Next
End Sub


Salut Jacky67 !! cela fonctionne à merveille !!!

Merci beaucoup !!

Aurais-tu un site à me conseiller pour apprendre la VBA !!

Merci
 
Aurais-tu un site à me conseiller pour apprendre la VBA !!
Re..
Ici, avec les bonnes questions 🙂
Eventuellement là 🙄
Non testé
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
2
Affichages
514
Réponses
2
Affichages
982
Réponses
4
Affichages
870
Retour