Macro appliqué à l'ensemble du classeur

[Garion]

Bonjour à tous.

J'ai une macro permettant de verrouiller les cellules mais celle-ci s'applique uniquement pour la Feuil1 ou 2 ou 3. Je souhaiterais que celle-ci soit appliqué à tout le classeur. Je suis sur que cela doit être simple mais n'étant un débutant cela ne me saute pas du tout au yeux.

La macro est la suivante :

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
 
    ActiveSheet.Unprotect Password:=""
    For Each c In Sheets("Feuil1").Range("A1:J1000")
        If c <> "" Then
            If c.MergeCells Then
                c.MergeArea.Locked = True
            Else
                c.Locked = True
            End If
        End If
    Next
    ActiveSheet.Protect Password:="", 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

Merci d'avance de votre aide

Garion

 

[mromain]

Re : Macro appliqué à l'ensemble du classeur

bonjour garion

si tu veux boucler sur les feuilles, il faut faire un truc du genre :

For Each s In ThisWorkbook.Worksheets
For Each c In s.Range("A1:J1000")
....
....
Next c
Next s

à tester

a+

 

[JNP]

Re : Macro appliqué à l'ensemble du classeur

Bonjour Garion ,
De la même façon que tu décrit toutes tes cellules, il te faut décrire toutes tes feuilles :

For Each WS In ThisWorkbook.Worksheets
WS.Activate
' Ta macro...
Next

Bonne journée

 

[Garion]

Re : Macro appliqué à l'ensemble du classeur

Rebonjour, tout d'abord merci pour vos réponses.

J'ai essayer de faire comme vous me le disiez. Cependant il me fixe une erreur au niveau de :

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)Je ne sais pas quel erreur j'ai pu faire.

Voila la macro complète :

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
 
    ActiveSheet.Unprotect Password:=""
    For Each sh In ActiveWorkbook.Sheets
        For Each c In sh.Range("A1:J1000")
            If c <> "" Then
                If c.MergeCells Then
                    c.MergeArea.Locked = True
                Else
                    c.Locked = True
                End If
            End If
        Next
        ActiveSheet.Protect Password:="", 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
        Next c
    Next sh
End Sub

merci à vous. Garion.

 

[JNP]

Re : Macro appliqué à l'ensemble du classeur

Re ,
Tu n'as pas bien lu mon post... Vu que tu n'actives pas ta feuille, ça bug évidemment. Il faut WS.Activate qui devient dans ta macro sh.activate juste après le For Each, soit

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    For Each sh In ActiveWorkbook.Sheets
        [COLOR=red]sh.activate[/COLOR]
        [COLOR=red]ActiveSheet.Unprotect Password:=""[/COLOR]
        For Each c In sh.Range("A1:J1000")
...

car si tu défini le Range dans sh, tu fait les déprotections/protections via ActiveSheet. D'un autre côté, si une feuille n'est pas protégée, il va beuguer sur la déprotection... A contourner avec On Error Resume Next.
Bon courage

 

[Garion]

Re : Macro appliqué à l'ensemble du classeur

Merci à toi la macro fonctionne à merveille.

Voila la macro pour ceux qui serai amener à consulter cette discussion :

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
 
    For Each sh In ActiveWorkbook.Sheets
        sh.Activate
        ActiveSheet.Unprotect Password:=""
        For Each c In sh.Range("A1:J1000")
            If c <> "" Then
                If c.MergeCells Then
                    c.MergeArea.Locked = True
                Else
                    c.Locked = True
                End If
            End If
        Next c
        ActiveSheet.Protect Password:="", 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
    Next sh
End Sub

Après je n'est pas trop compris l'erreur qui tu ma décrite. Peut être que cette macro permet de résoudre le problême que tu as soulevé. Il permet de vérouiller (et dévérouiller) une feuille après l'autre.

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Dim c As Range, Feuille As Worksheet
    For Each Feuille In ThisWorkbook.Worksheets
        Feuille.Unprotect Password:=""
        For Each c In Feuille.Range("A1:J1000")
            If c.Value <> "" Then
                If c.MergeCells Then
                    c.MergeArea.Locked = True
                Else
                    c.Locked = True
                End If
            End If
        Next
        ActiveSheet.Protect Password:="", 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
    Next
End Sub

Sinon la solution que tu me parlais est-ce un texte de ce genre :

On Error Resume Next
c.Locked = True
If Err.Number <> 0 Then
    Err.Clear
End If

Par contre je sais pas comment l'incorporer.

Merci encore de ton aide et que pense tu de ce que j'ai expliquer après.

Garion

 

[JNP]

Re : Macro appliqué à l'ensemble du classeur

Bonjour Garion ,
L'erreur dont je parlais était dans le cas où la feuille était déjà déprotégée. A ce moment là, UnProtect plante. Pour éviter le problème, il était possible de mettre

    For Each sh In ActiveWorkbook.Sheets
        sh.Activate
        [COLOR=red]On Error Resume Next[/COLOR]
        ActiveSheet.Unprotect Password:=""
        [COLOR=red]On Error GoTo 0[/COLOR]
        For Each c In sh.Range("A1:J1000")
        ...

Bonne journée