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

Version imprimable

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:

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:

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

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:

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:

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)

14/01/2009, 17h08
laurentabj

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...

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

Code:

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")

14/01/2009, 20h14
Pierre Fauconnier

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?
14/01/2009, 22h45
laurentabj

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
15/01/2009, 11h44
laurentabj

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:

Workbooks.Open Classeur

Merci d'avance à ceux que ça inspire...
Je rame !
15/01/2009, 12h32
fred65200

bonjour,
classeur = chemin complet du fichier
@+

Oui bien vu.
Mais la macro ne fonctionne toujours pas....

J'ai trouvé un code de Bill Manville.

Voici l'adaptation que j'en ai faite :

Code:

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
Sub UnprotectVBProject(WB As Workbook, ByVal Password As String)
    '
    ' Bill Manville, 29-Jan-2000
    '
    Dim VBP As VBProject, oWin As VBIDE.Window
    Dim wbActive As Workbook
    Dim i As Integer
 
    Set VBP = WB.VBProject
    Set wbActive = wbNEW
 
    If VBP.Protection <> vbext_pp_locked Then Exit Sub
 
    Application.ScreenUpdating = False
 
    ' Close any code windows To ensure we hit the right project
    For Each oWin In VBP.VBE.Windows
        If InStr(oWin.Caption, "(") > 0 Then oWin.Close
    Next oWin
 
    WB.Activate
    ' now use lovely SendKeys To unprotect
    Application.OnKey "%{F11}"
    SendKeys "%{F11}%OE" & Password & "~~%{F11}", True
 
 
    ' leave no evidence of the password
    Password = ""
    ' go back To the previously active workbook
    wbActive.Activate

Là encore je me retrouve avec la fenêtre des propriétés du projet ouverte, comme si le deuxième "~" du SendKeys n'avait pas été pris en compte....

15/01/2009, 14h29
laurentabj
Mes recherches sur les forums indiquent que la fonction SendKeys n'est pas très fiable, et que l'envoie des touches ne se fait pas toujours de façon synchronisée avec l'interface utilisateur.
Une touche peut par exemple être envoyée avant même que la fenêtre de saisie ne soit active.

Mes essais avec des boucles du genre ci-dessous ne donnent rien...
Code:

1 2 3 For Boucle=0 To 50 DoEvents Next Boucle
Je pense que je vais devoir délocaliser mon code de création dynamique d'un formulaire dans un autre xla (non verouillé celui-ci...), ce qui bien sûr, ne me satisfait pas.

N'hésitez pas à me faire part d'autres idées...

A bientôt
Laurent

Où places-tu ta boucle ?
Une explication sur ton observation

Citation:

"Une touche peut par exemple être envoyée avant même que la fenêtre de saisie ne soit active."

Tu ne te trompes pas. VBA continue à lire le code des lignes qui suivent une commande demandant au système un certain temps pour l'exécuter (ici l'affichage demandé de la fenêtre de saisie du mot de passe)
Donc l'emplacement de ta boucle est important.
Code:

1 2 3 4 5 6 7 8 9 Set Application.VBE.ActiveVBProject = vbProj For Boucle=0 To 5000 DoEvents Next Boucle SendKeys Password & "~~" For Boucle=0 To 5000 DoEvents Next Boucle Application.VBE.CommandBars(1).FindControl(ID:=2578, recursive:=True).Execute
Je te laisse tester ça ;)

re
tu peux essayer de mettre Sleep ou une temporasation de type

Code:

1
2
3
4
5
6
7
8
9
10
11
Function Attendre(Secondes As Integer)
' Cette procédure temporise pendant le nombre de secondes qu'on lui transmet en argument
'utilisation
'Attendre 1
Dim Début As Long, Fin As Long, Chrono As Long
Début = Timer
Fin = Début + Secondes
Do Until Timer >= Fin
    DoEvents
Loop
End Function

15/01/2009, 16h15
ouskel'n'or

En effet, et tu as aussi Wait

Code:

Application.Wait(Now + TimeValue("0:00:01"))

:langue:
15/01/2009, 20h18
laurentabj

Merci pour vos réponses. Je vais essayer tout cela demain.
Je vous tiens au courant...