Verrou, Déverrou, un onglet seulement avec bouton controle

Bonjour à Tous,

J'ai trouvé ce code sur le Forum.

Ce code protège ou dé-protège tous les onglets en même temps.

J'ai besoin d'aide pour appliquer ce code à un onglet seulement.

Je joins mon fichier en exemple.

Merci

Jean

Bonjour,

Présumant que c'est la feuille 1, qui contient le bouton, que tu veuilles gérer...

Un essai...

Dim Msg As String, Title As String, Caption As String
Dim r As Variant

Set ws2 = ActiveSheet
Set sh = ws2.Shapes(1)
Caption = sh.TextFrame.Characters.Text

Select Case Caption
Case "VERROUILLER"
'''   For Each ws In ActiveWorkbook.Worksheets
'''   ws.Protect Password:=PWD, UserInterfaceOnly:=True
'''   Next ws
'''   sh.TextFrame.Characters.Text = "DÉVEROUILLER"
   ActiveWorkbook.Worksheets("Feuil1").Protect Password:=PWD, UserInterfaceOnly:=True

   sh.TextFrame.Characters.Text = "DÉVEROUILLER"

Case "DÉVEROUILLER"
   'Msg = "SAISISSEZ LE MOT DE PASSE."
   'Title = "MOT DE PASSE ?"
   'r = Application.InputBox(prompt:=Msg, Title:=Title, Type:=2)
Select Case r
  Case PWD
'''   For Each ws In ActiveWorkbook.Worksheets
'''   ws.Unprotect Password:=PWD
'''   Next ws

   ActiveWorkbook.Worksheets("Feuil1").Unprotect Password:=PWD
   sh.TextFrame.Characters.Text = "VERROUILLER"
   ws2.Activate

Case False: Exit Sub
Case Else
'Msg = "LE MOT DE PASSE N'EST PAS VALIDE"
'MsgBox Msg, vbOKOnly + vbCritical, Title
Exit Sub
End Select
End Select
Set sh = Nothing: Set ws2 = Nothing
End Sub

Gelinotte

Bonjour gelinotte,

Ça fonctionne très bien.

Un GROS MERCI.

Jean.

Public Sub ProtectionWorkbook()
Dim Msg As String, Title As String, Caption As String
Dim r As Variant
Set ws2 = ActiveSheet
Set sh = ws2.Shapes(1)
Caption = sh.TextFrame.Characters.Text
Select Case Caption
Case "VERROUILLER"
'Indiquer le Nom de l'Onglet Voulu pour la Protection'
ActiveWorkbook.Worksheets("Feuil1").Protect Password:=PWD, UserInterfaceOnly:=True
sh.TextFrame.Characters.Text = "DÉVEROUILLER"
Case "DÉVEROUILLER"
Select Case r
Case PWD
ActiveWorkbook.Worksheets("Feuil1").Unprotect Password:=PWD
sh.TextFrame.Characters.Text = "VERROUILLER"
ws2.Activate
Case False: Exit Sub
Case Else
Exit Sub
End Select
End Select
Set sh = Nothing: Set ws2 = Nothing
End Sub