Limitation application macro

Résolu
doosoon -  
 doosoon -
Bonjour,

J'utilise une macro (récupérée sur ce site il y a qlqs semaines grâce à votre collaboration) qui à pour but d'autoriser l'utilisation des boutons de groupement / dégroupement sur des feuilles protégées.
J'avoue est ignare en VB ...
Cette macro est présente dans chaque worksheet. Le fichier en comporte une vingtaine.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim sh As Worksheet
For Each sh In Worksheets
sh.EnableAutoFilter = True
sh.EnableOutlining = True
sh.Protect Contents:=True, Password:="kisskiss", UserInterfaceOnly:=True
Next

End Sub

Mon pb: quand j'insère une nouvelle feuille dans ce fichier, la macro s'y applique alors que . je n'ai pas copier la macro dans la feuille.
De la même manière quand je déplace/ copie une de ces feuilles dans un autre fichier, la macro s'applique à l'ensemble des feuilles du fichier destinataire.
Je souhaiterais que la macro ne s'applique qu'à la feuille dans laquelle elle est copiée soit être capable de la désactiver dans les feuilles dans laquelle je ne souhaite pas qu'elle s'applique.

Merci de votre aide

2 réponses

  1. ccm81 Messages postés 11033 Statut Membre 2 434
     
    Bonjour

    Je souhaiterais que la macro ne s'applique qu'à la feuille dans laquelle elle est copiée

    Private Sub Worksheet_Change(ByVal Target As Range)
    Dim sh As Worksheet
    Set sh = ActiveSheet
    sh.EnableAutoFilter = True
    sh.EnableOutlining = True
    sh.Protect Contents:=True, Password:="kiss", UserInterfaceOnly:=True
    End Sub

    RQ. la macro me parait quand même bizarre, elle s'exécute dès qu'il y a un changement dans la feuille
    .Je pense qu'il faudrait préciser QUAND tu veux qu'elle s'exécute

    cdlmnt
    0
  2. Mike-31 Messages postés 18405 Date d'inscription   Statut Contributeur Dernière intervention   5 147
     
    Bonjour,

    Lorsque on copie un code sur un forum il est créé pour une demande bien précise, le code initial que j'ai mis en ligne était, et n'a rien à voir avec ta demande

    Option Explicit

    Private Sub Workbook_Open()
    On Error Resume Next
    Dim Sh As Worksheet
    For Each Sh In Sheets
    Sh.Protect Password:="open", DrawingObjects:=True, Contents:=True, Scenarios:=True _
    , AllowFiltering:=True
    Next Sh
    Sheets("P").Unprotect Password:="open"
    Sheets("P").EnableOutlining = True
    Sheets("P").Protect Password:="open", userInterfaceOnly:=True
    End Sub
    0
    1. doosoon
       
      Bonjour,

      Merci pour votre retour.

      Le code a été fourni par loups et eriiic pour la problématique évoquée:
      https://forums.commentcamarche.net/forum/affich-8693790-protection-grouper-des-cellules-dans-excel#p28132875

      Un collègue m'a permis de trouver la solution suivante qui me va bien et réponds au besoin exprimé:

      Private Sub Worksheet_Change(ByVal Target As Range)

      'if left(sh.name,2)="Pr" then
      ActiveSheet.EnableAutoFilter = True
      ActiveSheet.EnableOutlining = True
      ActiveSheet.Protect Contents:=True, Password:="kisskiss", UserInterfaceOnly:=True
      'end if

      End Sub

      Cordialement
      0