XL 2016 Verrouiller/déverrouiller projet VBA par macro

[dionys0s]

Bonjour le forum

J'ai un classeur dont l'accès au code est protégé par mot de passe. J'aimerais savoir s'il existe un moyen de déverrouiller et verrouiller le projet par macro.
J'ai bien trouvé ce code pour la protection mais son exécution plante :

Sub ProtectVBProject(WB As Workbook, ByVal Password As String)

  Dim vbProj As Object

  Set vbProj = WB.VBProject
  If vbProj.Protection = 1 Then Exit Sub
  Set Application.VBE.ActiveVBProject = vbProj
  Application.VBE.CommandBars(1).FindControl(ID:=78, Recursive:=True).Execute 'La macro plante sur cette ligne
  SendKeys "+{TAB}{RIGHT}%V{+}{TAB}" & Password & "{TAB}" & Password & "~", True

End Sub

Sub UnprotectVBProject(WB As Workbook, ByVal Password As String)

  Dim vbProj As Object

  Set vbProj = WB.VBProject
  If vbProj.Protection <> 1 Then Exit Sub
  Set Application.VBE.ActiveVBProject = vbProj
  Application.VBE.CommandBars(1).FindControl(ID:=78, Recursive:=True).Execute 'La macro plante sur cette ligne
  SendKeys Password & "~"
  SendKeys "~"

End Sub

D'avance, merci pour votre aide !

 

[Dranreb]

Bonjour.
Essayez en mettant les SendKeys avant Execute, et moi j'ai retrouvé dans les codes ID:=2578, non 78

Sub UnprotectVBProject(ByVal WB As Workbook, ByVal Password As String)
   If WB.VBProject.Protection = 1 Then
      Set Application.VBE.ActiveVBProject = WB.VBProject
      SendKeys Password & "~~"
      Application.VBE.CommandBars(1).FindControl(Id:=2578, Recursive:=True).Execute
      DoEvents: End If
   End Sub

 

[dionys0s]

Bonjour Dranreb

Merci beaucoup pour votre réponse, ça fonctionne au poil.

Sub ProtectVBProject(ByRef wkb As Workbook, ByVal Password As String)

  If wkb.VBProject.Protection = VBIDE.vbext_pp_none Then
    Set Application.VBE.ActiveVBProject = wkb.VBProject
    Call VBA.SendKeys("+{TAB}{RIGHT}%V{+}{TAB}" & Password & "{TAB}" & Password & "~", True)
    Application.VBE.CommandBars(1).FindControl(ID:=2578, Recursive:=True).Execute
  Call VBA.DoEvents: End If

End Sub

Sub UnprotectVBProject(ByRef wkb As Workbook, ByVal Password As String)

  If wkb.VBProject.Protection = VBIDE.vbext_pp_locked Then
    Set Application.VBE.ActiveVBProject = wkb.VBProject: Call VBA.SendKeys(Password & "~~")
    Call Application.VBE.CommandBars(1).FindControl(ID:=2578, Recursive:=True).Execute
  Call VBA.DoEvents: End If

End Sub

2 questions toutefois :
* Cela fonctionne sur toutes les versions post 2007 ?
* Comment avez-vous trouvé la constante 2578 ?

Bonne journée

 

[Dranreb]

J'ignore si ça fonctionne sur toutes les versions mais d'une façon générale VBE n'évolue plus, j'ai l'impression.
Je ne sais plus du tout où j'avais trouvé cette constante, donc il faudrait le rechercher sur internet.

 

[amsauget]

Bonjour Dranreb

Merci beaucoup pour votre réponse, ça fonctionne au poil.

Sub ProtectVBProject(ByRef wkb As Workbook, ByVal Password As String)

  If wkb.VBProject.Protection = VBIDE.vbext_pp_none Then
    Set Application.VBE.ActiveVBProject = wkb.VBProject
    Call VBA.SendKeys("+{TAB}{RIGHT}%V{+}{TAB}" & Password & "{TAB}" & Password & "~", True)
    Application.VBE.CommandBars(1).FindControl(ID:=2578, Recursive:=True).Execute
  Call VBA.DoEvents: End If

End Sub

Sub UnprotectVBProject(ByRef wkb As Workbook, ByVal Password As String)

  If wkb.VBProject.Protection = VBIDE.vbext_pp_locked Then
    Set Application.VBE.ActiveVBProject = wkb.VBProject: Call VBA.SendKeys(Password & "~~")
    Call Application.VBE.CommandBars(1).FindControl(ID:=2578, Recursive:=True).Execute
  Call VBA.DoEvents: End If

End Sub

2 questions toutefois :
* Cela fonctionne sur toutes les versions post 2007 ?
* Comment avez-vous trouvé la constante 2578 ?

Bonne journée

Bonjour Dyonis0s,

J'ai lu avec intérêt votre échange du 14 Août 2019 (jamais trop tard pour lire des choses intéressantes !).
Cela concerne la sub :
ProtectVBProject(ByRef wkb As Workbook, ByVal Password As String)

J'aimerais savoir comment faire appel à ces procédures svp...
J'ai tenté de l'utiliser comme suit :
ProtectVBProject ("C:\...\ffff.xlsm" , "MonPassword")
et
ProtectVBProject ="C:\...\ffff.xlsm" ; "MonPassword"
Le système n'accepte pas évidemment...

Je suppose aussi que l'appel peut se faire en Private Sub Workbook_Open() ?
Pourriez vous me donner un exemple d'appel SVP ?

Merci de votre aide.

 

[dionys0s]

Bonjour Amsauget,

La réponse arrive un peu tard, mais je n'avais pas vu le mail auparavant...

voici le code qui permet d'appeler les fonctions : le premier argument est un objet Workbook.

Private Sub Proteger()
  Call ProtectVBProject(ThisWorkbook, "toto")
End Sub

Private Sub Liberer()
  Call UnprotectVBProject(ThisWorkbook, "toto")
End Sub

On peut en effet mettre ces appels dans une procédure événementielle :

Option Explicit

Private Sub Workbook_BeforeClose(Cancel As Boolean)
  Call ProtectVBProject(ThisWorkbook, "toto")
End Sub

Private Sub Workbook_Open()
  Call UnprotectVBProject(ThisWorkbook, "toto")
End Sub

Bonne journée !

 

[soan]

Bonjour,

j'comprends pas : si un projet VBA est déjà verrouillé avec un mot de passe, comment
pouvez-vous y ajouter du code VBA ? c'est pas possible vu qu'en cliquant sur la ligne
VBAProject d'un projet verrouillé, ça demande le password !

soan

 

[dionys0s]

Bonjour soan,

le code proposé n'ajoute pas du code VBA dans le projet, il verrouille ou déverrouille le code VBA du projet.
Cela dit, présenté tel quel, il n'est pas très intéressant. Mais associé à une liste d'utilisateurs avec des droits associés, ça peut être intéressant. A l'ouverture du classeur, la macro événementielle Workbook_Open va vérifier si l'utilisateur fait partie des utilisateurs habilités à voir/modifier le code, et si oui, déverrouiller le projet. Dans le cas inverse, la macro ne va rien faire, et l'utilisateur non habilité ne pourra pas consulter le code.

 

[soan]

Bonjour dionys0s,

je viens de lire ton post, et je te remercie pour ta réponse !

soan

 

[fanch55]

Bonjour,
Je rejoins @dionys0s :
Pourquoi protéger le vb si c'est pour le désactiver à l'ouverture ...
D'autant plus qu'il faut utiliser des sendkeys qui sont toujours envoyés vers l'application active ( bouteille à la mer ) .
Imaginez qu'une autre application (antivirus,notification, etc...) s'active à ce moment là et fasse des opérations à partir de la séquence envoyée, ce ne sera pas forcément ce que vous désiriez .

Sinon, les protections par mot de passe sous Excel, que ce soit pour les feuilles ou pour le Vbe sont dérisoires.
URL modérée par l'administrateur en accord avec les points 8 et 9 de la charte (mise à jour de la charte le 9/12/2020)

Nota: cette url est donnée à titre informative parmi tant d'autres ...

 

[soan]

Bonjour fanch55,

merci à toi aussi pour ces autres infos intéressantes,
y compris ton lien du site Webanalytix.

soan