Déprotéger / protéger projet en VBA

**laurentabj** · 14/01/2009, 15h42

Bonjour à tous,

J'ai essayé 50 fois de faire fonctionner le code ci-dessous proposé par bbil pour protéger puis déprotéger le projet vba.
Mais rien n'y fait, ma procédure s'arrête inévitablement sur la fenêtre des propriétés du projet, nécessitant un appui manuel sur la touche [ENTER]

Ceci se produit à la deprotection ainsi qu'à la reprotection. Quelqu'un aurait une idée ?

Merci à vous

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
 
 
Sub TestProtect() 
ProtectVBProject Workbooks("Proteger_deproteger.xls"), "motdepasse" 
End Sub 
 
Sub TestUnprotect() 
UnprotectVBProject Workbooks("Proteger_deproteger.xls"), "motdepasse" 
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 
 
   SendKeys Password & "~~" 
  Application.VBE.CommandBars(1).FindControl(ID:=2578, recursive:=True).Execute 
End Sub 
 
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 
 
 
  SendKeys "+{TAB}{RIGHT}%V{+}{TAB}" & Password & "{TAB}" & _ 
Password & "~" 
 
  Application.VBE.CommandBars(1).FindControl(ID:=2578, recursive:=True).Execute 
 
  WB.Save 
End Sub

Et voici mon code adapté :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
 
 
 
Sub UnprotectVBProject(WB As Workbook, ByVal PwD As String)
 
Dim vbProj As Object
Set vbProj = WB.VBProject
If vbProj.Protection <> 1 Then Exit Sub
Set Application.VBE.ActiveVBProject = vbProj
SendKeys PwD & "~~"
Application.VBE.CommandBars(1).FindControl(ID:=2578, recursive:=True).Execute
 
 
 
End Sub
 
 
 
 
Sub ProtectVBProject(WB As Workbook, ByVal PwD As String)
Dim vbProj As Object
 
Set vbProj = WB.VBProject
 
'can't do it if already locked!
If vbProj.Protection = 1 Then Exit Sub
 
Set Application.VBE.ActiveVBProject = vbProj
 SendKeys "+{TAB}{RIGHT}%V{+}{TAB}" & PwD & "{TAB}" & PwD & "~"
Application.VBE.CommandBars(1).FindControl(ID:=2578, recursive:=True).Execute
'  WB.Save
End Sub

**ouskel'n'or** · 14/01/2009, 16h49

Chez moi ce code fonctionne si... s'il est intégré au classeur que je souhaite déprotéger.
J'associe le nom d'utilisateur comme condition à la déprotection. Effectivement, n'importe qui utilise ma session peut ouvrir mes fichiers...
Dans Thisworkbook

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
Private Sub Workbook_Open()
Dim WB As Workbook, Pass As String
    Application.EnableEvents = false
    if not Environ("Username") = "MonNom" then exit sub
    Application.EnableEvents = True
    Set WB = ThisWorkbook
    Pass = "zizou"
    UnprotectVBProject WB, Pass
End Sub

Et dans le module :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
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
    SendKeys Password & "~~"
    Application.VBE.CommandBars(1).FindControl(ID:=2578, recursive:=True).Execute
End Sub

Pas réussi à le faire fonctionner pour un fichier autre que celui contenant la macro

(en l'occurence, je m'en moque)

**laurentabj** · 14/01/2009, 17h08

Merci de ta réponse ouskel'n'or !

Mon module est bien dans le projet à protéger.
Il s'agit d'un fichier .xla

Je réussi à faire fonctionner le code de temps en temps, mais cela paraît aléatoire (?!)

Comme si le sendkeys n'avait pas toujours le temps de transmettre la totalité des keys avant leur traitement...

**fred65200** · 14/01/2009, 20h03

bonjour,
tu peux tester cette fonction un peu plus élaborée

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
Private Declare Function FindWindowA Lib "User32" _
  (ByVal lpClassName As String, _
  ByVal lpWindowName As String) As Long
 
Private Declare Function GetForegroundWindow Lib "User32" () As Long
 
Private Declare Function SetForegroundWindow Lib "User32" _
  (ByVal hWnd As Long) As Long
 
Function Déprotège(Classeur As String, MdP As String) As Boolean
 
  Dim XLhWnd As Long, VBEhWnd As Long, CurhWnd As Long
  Dim Wbk As Workbook
 
  On Error Resume Next
  Set Wbk = Workbooks(Dir$(Classeur))
  On Error GoTo Fin
  If Not Wbk Is Nothing Then
    If Wbk.FullName <> Classeur Then Exit Function
    If Not Wbk.Saved Then Wbk.Save
  Else: Application.ScreenUpdating = False
  End If
 
  CurhWnd = GetForegroundWindow
  XLhWnd = FindWindowA(vbNullString, Application.Caption)
 
  With Application.VBE
    VBEhWnd = FindWindowA(vbNullString, .MainWindow.Caption)
    If CurhWnd = XLhWnd Then SetForegroundWindow VBEhWnd
      .CommandBars.FindControl(ID:=2557).Execute
    ' NE PAS EFFACER, même si le classeur est déjà ouvert !!!!!!
    Workbooks.Open Classeur
    If ActiveWorkbook.VBProject.Protection = vbext_pp_locked Then
      SendKeys "~" & MdP & "~", True
      .ActiveCodePane.Window.Close
    End If
  End With
 
  SetForegroundWindow CurhWnd
  Déprotège = True
  Exit Function
 
Fin:
End Function

Cordialement
EDIT : avec cette fonction, on s'assure que c'est bien la bonne fen^tre qui reçoit le SendKeys.
elle s'utilise de la façon suivante :
Déprotège("Chemin du Classeur.xls", "Mot de Passe")

**Pierre Fauconnier** · 14/01/2009, 20h14

Salut tout le monde (Fred, Ousk et Laurent)

Pas sûr, mais ne faudrait-il pas vérifier si "Faire confiance au projet Visual Basic" ne devrait pas être coché dans Outils/Macro/Sécurité/Editeurs approuvé?

Cela étant, si ton projet est un projet VBA, je ne vois pas l'intérêt de devoir le déprotéger par macro. Quel est ton but en faisant cela?

**laurentabj** · 14/01/2009, 22h45

Bonsoir à tous et merci pour vos réponses,

@ Fred : oui, j'ai également essayé ce code mais sans succès (et aussi avec moins d'acharnement car je ne comprends pas tout). Je vais essayer de l'explorer davantage.

@ Pierre : les paramètres de sécurité de mon projets sont tous au vert, et Excel a toute confiance en mon projet. J'ai besoin de cette fonction car mon xla génère dynamiquement la construction d'un userForm ainsi que du code associé.
En effet, mon xla communique avec le ActiveWorkbook en présence, et se compose différemment (nombre de controls) en fonction du contenu de ce ActiveWorkbook.

Je poursuis mes recherches et j'espère que vous les experts saurez me mettre sur la voie. Je suis quand même plus que troublé par le comportement de cette fonction SendKeys.

Laurent

**laurentabj** · 15/01/2009, 11h44

Bonjour à tous,

J'ai réessayé d'utiliser le code proposé par Fred, mais j'obtiens un message d'erreur : "Erreur définie par l'application ou par l'objet"

Apparemment, l'erreur se déclenche sur la commande suivante :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part