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

[MrThity]

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"

 

[Jacky67]

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

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

 

[MrThity]

Bonsoir,
A tester comme ceci

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

 

[Jacky67]

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

Re..
Ici, avec les bonnes questions 🙂
Eventuellement là 🙄

Cours VBA gratuit

Apprenez le VBA (Excel) gratuitement étape par étape grâce aux leçons et exercices proposés sur ce site (variables, conditions, boucles, procédures, fonctions, boîtes de dialogue, événements, userforms, etc).

www.excel-pratique.com

Non testé

 

[MrThity]

Re..
Ici, avec les bonnes questions 🙂
Eventuellement là 🙄

Cours VBA gratuit

Apprenez le VBA (Excel) gratuitement étape par étape grâce aux leçons et exercices proposés sur ce site (variables, conditions, boucles, procédures, fonctions, boîtes de dialogue, événements, userforms, etc).

www.excel-pratique.com

Non testé

Merci bien !!