XL 2016 Verrouiller/déverrouiller projet VBA par macro

dionys0s

XLDnaute Impliqué
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 :
VB:
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

XLDnaute Barbatruc
Bonjour.
Essayez en mettant les SendKeys avant Execute, et moi j'ai retrouvé dans les codes ID:=2578, non 78
VB:
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

XLDnaute Impliqué
Bonjour Dranreb

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

VB:
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

XLDnaute Barbatruc
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

XLDnaute Nouveau
Bonjour Dranreb

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

VB:
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

XLDnaute Impliqué
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.
VB:
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 :
VB:
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

XLDnaute Accro
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

XLDnaute Impliqué
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.
 

fanch55

XLDnaute Impliqué
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.
Nota: cette url est donnée à titre informative parmi tant d'autres ... 😎
 
Dernière édition:

soan

XLDnaute Accro
Bonjour fanch55,

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


soan
 

Créez un compte ou connectez vous pour répondre

Vous devez être membre afin de pouvoir répondre ici

Créer un compte

Créez un compte Excel Downloads. C'est simple!

Connexion

Vous avez déjà un compte? Connectez vous ici.

Haut Bas