XL 2013 VBA / Proteger et déproteger avec un seul shape ou image (pas de bouton).

[PMG]

Bonjour le forum,

J'espère que vous allez bien malgré cette période de confinement un peu particulière!
Je me permets de solliciter vos connaissance concernant un problème de protection / déprotection avec un shape ou une image.

Toutes les feuilles du classeur sont à protéger / déprotéger via un shape qui ce trouve uniquement sur les sur les trois premières feuilles, car les autres sont des bases de données.
1er clic = déprotéger classeur + zonetexte = protection
2ème clic = protéger classeur + zonetexte = déprotection
etc...

J'ai essayé de plusieurs manière et je retombe à chaque fois sur le même problème, après plusieurs cycles de clics je ne reste jamais sur la feuille active.
Merci de votre temps et de vos lumières!
PMG

Option Explicit
Sub Protège()
Dim Ws As Worksheet
Application.ScreenUpdating = False

If ActiveSheet.Shapes.Range(Array("ZoneTexte 2")).TextFrame2.TextRange = "protection" Then
For Each Ws In Sheets
Ws.Protect Password:="", userinterfaceonly:=True
Next Ws
For Each Ws In Sheets(Array("Feuil1", "Feuil2", "Feuil3"))
Ws.Shapes.Range(Array("ZoneTexte 2")).TextFrame2.TextRange = "déprotection"
Next Ws
Else
If ActiveSheet.Shapes.Range(Array("ZoneTexte 2")).TextFrame2.TextRange = "déprotection" Then
For Each Ws In Sheets
Ws.Unprotect Password:=""
Next Ws
For Each Ws In Sheets(Array("Feuil1", "Feuil2", "Feuil3"))
Ws.Shapes.Range(Array("ZoneTexte 2")).TextFrame2.TextRange = "protection"
Next Ws
End If
End If

ActiveSheet.Select
Application.ScreenUpdating = True
End Sub

 

[Jacky67]

Bonjour le forum,

J'espère que vous allez bien malgré cette période de confinement un peu particulière!
Je me permets de solliciter vos connaissance concernant un problème de protection / déprotection avec un shape ou une image.

Toutes les feuilles du classeur sont à protéger / déprotéger via un shape qui ce trouve uniquement sur les sur les trois premières feuilles, car les autres sont des bases de données.
1er clic = déprotéger classeur + zonetexte = protection
2ème clic = protéger classeur + zonetexte = déprotection
etc...

J'ai essayé de plusieurs manière et je retombe à chaque fois sur le même problème, après plusieurs cycles de clics je ne reste jamais sur la feuille active.
Merci de votre temps et de vos lumières!
PMG

Bonjour,
Tester la pj

 

[job75]

Bonjour PMG, Jacky67, le forum,

Une solution un peu plus simple dans le fichier joint :

Sub Protection()
Dim s As Object
ThisWorkbook.Names.Add "P", IsError([1/P]) 'nom défini dans le classeur
For Each s In Sheets(Array("Feuil1", "Feuil2", "Feuil3"))
    s.DrawingObjects("ZoneTexte 2").Text = IIf([P], "Déprotéger", "Protéger")
    If [P] Then s.Protect Else s.Unprotect
Next
End Sub

Il est inutile de vouloir déprotéger les feuilles BD1 BD2 BD3 car si un rigolo les protège avec mot de passe il y aura un bug.

Bonne journée.

 

[PMG]

Bonjour Jacky67, job75, le forum,
Merci bcp pour vos réponses,

Jacky67, j'ai bien regardé le fichier, il marche sur un pc avec excel 2007 mais pas sur le mien avec excel 2013, je finis tjs sur une autre feuille en l’occurrence "BD2". Je n'ai pas compris pourquoi?

Job75, votre code marche très bien. Est il possible de rendre 2 images en show/hide avec votre code?
J'ai ajouter:
s.Pictures ("Image 1").Visible = IIf([P], "False", "True")
cela semble marcher, je ne sais pas si c'est la meilleure solution?
Merci.
PMG

 

[job75]

Utilisez plutôt :

s.Pictures("Image 1").Visible = Not [P]

Bonne nuit.