Discussion :

[laurentabj]

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]

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]

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]

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]

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]

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]

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

Workbooks.Open Classeur

Merci d'avance à ceux que ça inspire...
Je rame !

[fred65200]

bonjour,
classeur = chemin complet du fichier
@+

[laurentabj]

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 :

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

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

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

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

[ouskel'n'or]

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

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

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

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

[fred65200]

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

Code :

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

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

@+

[ouskel'n'or]

En effet, et tu as aussi Wait

Code :

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

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

[laurentabj]

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