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

MrThity à dit:

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"

Cliquez pour agrandir...

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

Jacky67 à dit:

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

Cliquez pour agrandir...

MrThity à dit:

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

Cliquez pour agrandir...

Jacky67 à dit:

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é

Cliquez pour agrandir...