Ajouter une option à un menu

Bonjour,

Est-ce possible de rajouter une option au menu "Action" dans le module ModuleDeblocage :

B = Bloquer à nouveau

Pourquoi ?

J'ai plusieurs tâches qui ne se réalisent pas complètement quand je débloque tous les accès. Si bien que je suis obligé de fermer le classeur pour le rouvrir afin d'activer correctement toutes les macros.

J'aimerais, si possible, que le "B" remette l'état du classeur comme si je l'ouvrais, en rebloquant le tout.

Sub M_Debloquer_Quitter()
     Dim Reponse, b
     Do
          Reponse = Application.InputBox("Que voulez-vous faire ?" & vbLf & vbLf & "Q = Quitter sans sauvegarder" & vbLf & _
                                         "S = Sauvegarder et quitter" & vbLf & " I = sauvegarde Intermédiaire sans quitter" & vbLf & "R = Rien" & vbLf & "Sinon, si vous avez le mot de passe pour tout débloquer, saisissez-le ==>", "Action", Type:=2)
          b = True
          Select Case Reponse
               Case "Q", "S", "q", "s": ThisWorkbook.Close SaveChanges:=(StrComp(Reponse, "S", 1) = 0)
               Case "I", "i": ThisWorkbook.Save
               Case "R", "r"
               Case "vodoraix": Deblocage    'option pas mentionnée : directement le MdP = debloquer
               Case Else: b = False
          End Select
     Loop While Not b
End Sub

Private Sub Deblocage()
     Dim b

     b = (Sheets("Concordance Classmt & points").Visible = True)     'cette feuille est visible = maintenant, on fait le contraire
     Sheets("Concordance Classmt & points").Visible = IIf(Not b, True, xlVeryHidden)
     Sheets("dossiers pour PDF").Visible = IIf(Not b, True, xlVeryHidden)
     On Error Resume Next
     With Application
          .DisplayFullScreen = b
          .CommandBars("Worksheet Menu Bar").Enabled = b
     End With
     Application.Goto Sheets("Classmt par discipline+Général").Range("A3"), 1
End Sub

De plus lorsque je fais un déblocage complet, les feuilles restent quand même bloquées par un mdp. Mais ça n'est peut-être pas possible de tout débloquer ?

Merci pour votre lecture...

Sur le bouton "Débloquer ou Quitter", tapez vodoraix pour tt débloquer.

Et mot de passe pour débloquer les feuilles ==> seb

Bonne journée

à bientôt...

Bonjour,

Tu veux que l’option B se contente de rebloquer feuilles et menus, ou qu’elle simule une réouverture complète du classeur (équivalent d’un Workbook_Open) ?

bonjour vodoraix

* dans Thisworkbook, supprimez le "private" en face de "Workbook_open()", comme ça, on peut lancer la macro ailleurs.

* puis modifier la macro comme ceci

Sub M_Debloquer_Quitter()
     Dim Reponse, b
     Do
          Reponse = Application.InputBox("Que voulez-vous faire ?" & vbLf & vbLf & "Q = Quitter sans sauvegarder" & vbLf & _
                                         "S = Sauvegarder et quitter" & vbLf & " I = sauvegarde Intermédiaire sans quitter" & vbLf & _
                                         "B = Bloquer à nouveau" & vbLf & "R = Rien" & vbLf & "Sinon, si vous avez le mot de passe pour tout débloquer, saisissez-le ==>", "Action", Type:=2)
          b = True
          Select Case Reponse
               Case "Q", "S", "q", "s": ThisWorkbook.Close SaveChanges:=(StrComp(Reponse, "S", 1) = 0)
               Case "I", "i": ThisWorkbook.Save
               Case "R", "r"
               Case "B", "b": ThisWorkbook.Workbook_Open 'votre nouvel option = relancer dans "thisworkbook" la macro "Workbook_open"
               Case "vodoraix": Deblocage    'option pas mentionnée : directement le MdP = debloquer
               Case Else: b = False
          End Select
     Loop While Not b
End Sub

Bonsoir bonsoir Bart' et encore milles mercis

Et merci à PaulExcelVBA. Vui pour le worbook

Je teste à l'instant même & tt fonctionne à merveille, comme d'hab

Juste quand on débloque tout, toutes les feuilles restent bloquées. Y'a moyen d'agir sur elles ?

Bonne soirée à vous 2

Bonsoir,

Oui c'est normal, ton code ne fait que changer la visibilité et l’UI. Les feuilles restent protégées par mot de passe. Il faut ajouter Unprotect sur chaque feuille (et éventuellement sur la structure du classeur), puis les re-protéger quand tu “rebloques”.

Bonjour Paul et merci bcp

Ce soir, si c'est ok pour toi, je proposerai un sub pour savoir comment je dois procéder...

Je pars travailler à l'instant et n'ai pas le net au boulot...

Merci. Bonne journée :-))))

Bonjour Paul,

Voici mes feuilles :

Et voici le code de la première procédure sub de l'objet Blad1 :

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

     If Not Intersect(Target, Me.Range("tabel1").Offset(-2).Resize(2)) Is Nothing Then
          Enlever_Filtre                     'double-clicque dans les lignes 2-3
     Else
          Select Case Target.Column          'DAN : éviter double-clicque dans certaines colonnes
               Case Is = 8, 13, 18, 23, 27, 32, 36
                    col = Target.Column
                    If Not Intersect(Target, Range("Tabel1").ListObject.ListColumns(col).DataBodyRange) Is Nothing Then
                         Cancel = True
                    End If
          End Select
     End If

End Sub

Le unprotect serait à glisser à quels endroits de mes sub, stp ?

Et comment fait-on pour la structure du classeur ?

MErci Paul...

à +

Bonsoir,

De façon générale, le unprotect en début de procédure et protext en fin de procédure ;)

Paul

D'accord et merci Paul...

Et malgré tout, à l'ouverture du classeur ou par l'option "B" du menu, tout restera bloqué ? C-à-d que le ThisWorkBook prend le dessus sur tout ?

Encore merci pour ton aide...

Bonne journée

Hello

Je ne suis pas sûr de bien comprendre mais tu as 3 façon d'utiliser le unprotect/protect

Sur une feuille spécifique

1 Worksheets("NomFeuille").Unprotect "motdepasse"

2 ActiveSheet.Unprotect "motdepasse"

Sur le web

3 ThisWorkbook.Unprotect "motdepasse"

Bonjour Paul et merci bcp pour les explications

De mémoire, BsAlv a souvent utilisé le

Worksheets("NomFeuille").Unprotect "motdepasse"

Ca se met à des endroits précis. Je vais essayer mais sans certitude de bien l'employer.

Merci

Bon w.e.

à bientôt