Appliquer la macro à tous le classeur

Question

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 : Code: 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

Garion27 · Answer

Edit : désolé la macro n'apparaissait pas. La voilà :

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

bigfish_le vrai · Answer

Salut,

Une petite remarque pour commencer : Tu n'es pas dans le bon theme !... Pour Excel et plus generalement le VBA c'est ici :

--->  Thèmes / Visual Basic 6 / Langages dérivés / VBA /

Non non !!! ne reposte pas ailleurs on continu malgré tout avec celui-ci !

Si j'ai bien compris ceci devrait faire l'affaire: (ce qui a changé est en bleu)

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Dim c As Range, Feuille As Worksheet
    For Each Feuille In ThisWorkbook
        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

A+

Garion27 · Answer

Rebonjour, tout d'abord merci de ton aide et aussi pour ta remarque. Je ne savez pas trop ou poster et comme ce forum comporte beaucoup de thème.

J'ai tester mais à l'activation de la macro lors de l'enregistrement, il y a une erreur : "erreur d'éxécution 438, propriété ou méthode non gérée par cette objet ".

Avec le débogage sa me fixe sur "For Each Feuille In ThisWorkbook"

Je sais pas du tout répondre à cette erreur. Peut-être une erreur de ma part je n'en sais rien. A-tu une idée ?

Garion

bigfish_le vrai · Answer

Ouups... òO'

effectivement il manque quelque chose

For Each Feuille In ThisWorkbook.Worksheets

Garion27 · Answer

Avec la modif que tu viens d'apporter il n'y a plus d'erreur. Cependant, je ne peut plus rentrer des données dans les cellules vides et donc le but de ma macro. A tu une aidez ?

merci beaucoup de ton aide et pour le temps que tu passe à m'aider.

Garion

bigfish_le vrai · Answer

comprend pas ??? en faite ce code verouille toutes les cellules vides


Si ce n'est pas ce que tu voulais, c'est a dire verouiller les cellules
non videsvides,  soit le contraire de ce que fait ton code.
Il suffit de
remplacer:

Locked = True

par

Locked = False

us_30 · Answer

Bonjour,

A quoi sert ces lignes  ? (on parle de cellules, non ?...)

        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

Amicalement,
Us.

Garion27 · Answer

Bonjour à tous. Désolé de ne avoir pu vous répondre plus tot je n'avais l'accès à l'ordinateur. Pour répondre à la question de us-30, les lignes que tu as cité me permette de remplir les lignes vides sans avoir à dévérouiller les cellules déjà remplies au précédent usage du fichier. De plus cela permet entre autre de changer le format et rajouter des colonne ou ligne sans aussi enlever la protection. Pour la macro tout est nickel. C'était une erreur de ma part j'avais oublier de dévérouiller les cellules avant de mettre la macro donc s'était normal que je puisse pas entrée des données dans les cellules vides. Voila pour info le code final : 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 Cette macro permet de vérouiller les feuille une à une donc pour ceux que sa interesse celle-ci vérouille toute les cellules d'un coup (à titre informatif) : 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 Merci encore à toi Bigfish le vrai. Garion

Appliquer la macro à tous le classeur

8 réponses

Votre réponse

Discussions similaires