Discussion :

[martiweb]

Bonsoir.
Je travaille sous Windows Xp Pro SP2 avec Excel 2003.
J’ai un classeur « Loisirs.xls » pour lequel j’ai protégé son code VBA par un mot de passe.
C'est-à-dire que lorsque j’ouvre Microsoft Visual basic (par Alt+F11) de ce classeur, et que je veux déployer la liste de mes modules en cliquant sur le bouton + de VBAProject(Loisirs.xls)
Le mot de passe m’est demandé. (que je possède car je l’ai créé, ce n’est pas pour déprotéger un classeur soyons clair)
A partir d’un autre classeur, je voudrai ajouter un module dans ce classeur « Loisir.xls ».
Il me faut donc déprotéger, ajouter le module et reprotéger le classeur « Loisirs.xls ».
Ce classeur se trouve dans le répertoire :
C:\Vacances\
Son mot de passe : toto1 (pour l’exemple)

J’ai adapté la macro, de Laurent Longre, mpfe, suivante :

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
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
 
'Attribute VB_Name = "DeprotegeProjetVBA"
 
'=================================================
'Laurent Longre, mpfe
 
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
 
______________________________________________
 
Sub DeprotegeVBA()
 
  ' Déprotection du projet VBA C:\Temp\Test.xls (mot de passe "Zaza"),
  ' Ajout d'un module standard dans ce projet, puis rétablissement
  ' de la protection
 
  Const Classeur = "C:\Vacances\Loisirs.xls"
  If Not Déprotège(Classeur, "toto1") Then
    MsgBox "Erreur"
  Else
    MsgBox "Projet VBA déprotégé."
    With Workbooks(Dir$(Classeur))
      .VBProject.VBComponents.Add vbext_ct_StdModule
      .Close True
    End With
    Workbooks.Open Classeur
    MsgBox "Projet reprotégé, ajout d'un module standard."
  End If
 
End Sub

Mais cela ne fonctionne pas dans mon cas.
Quant je lance cette macro pas à pas avec F8, tout se déroule bien sans erreurs jusqu'à l’affichage du Msgbox : « Projet VBA déprotégé ».
Or, en vérifiant, le classeur n’est pas déprotégé !
Je m’aperçois que le problème se situe au niveau de la ligne :

Code :

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

1
2
 
 If ActiveWorkbook.VBProject.Protection = vbext_pp_locked Then

La macro ne passe pas par :

Code :

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

1
2
 
SendKeys "~" & MdP & "~", True

Mais saute directement en

Code :

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

1
2
 
End If

De plus la variable : vbext_pp_locked = vide (est-ce pour cela que je saute directement à End if)

La macro, elle, continue donc jusqu'à l’affichage du Msgbox « Projet VBA déprotégé ».
Mon classeur n’est donc pas déprotégé malgré le Msgbox et je ne peux pas lui ajouter un module.
Est-ce que l’erreur provient de la macro utilisée qui n’est pas en VBA mais en VB. (je ne suis pas un spécialiste en la matière pour m’en rendre compte…), que me conseillez-vous ?
Merci pour votre aide.
Bonne soirée.

[ouskel'n'or]

En attendant que je teste ton code, j'ai une adresse dont le code devrait convenir à ton problème.
Tu dis

[SfJ5Rpw8]

j'ai pas testé le code mais
pour vbext_pp_locked, rajoute la référence à "Microsoft Visual basic for application extensibility...."
où remplace le par 1..

[ouskel'n'or]

Merci bbil, tu m'évites des recherches... "longues et fastidieuses"... , surtout pour un dimanche matin
Juste un truc, la solution proposée par Blondelle ne cécessite pas de déclaration supplémentaire. Pour ça qu'elle me plaisait bien.
Ceci dit, autant que martiweb termine avec son code.

[martiweb]

Bonjour et merci d’avoir pris la peine de me répondre.
Il est vrai que, pris par cette passion de programmer malgré mon peu de savoir sur VBA (j’apprends) et disposant de tout mon temps dû au fait d’être un papy retraité, je ne me rends pas compte que parfois je pose des questions le dimanche alors que la jeunesse à autre chose à faire ! C’est bien normal.

J’ai suivi le conseil de ouskel'n'or et j’ai repris, sur le lien donné, le code, avec les conseils, sur la page de Blondelle.
J’ai renommé mon classeur comme dans l’exemple :
Proteger_deproteger.xls
Je l’ai mis dans le répertoire C:\Temp\ Proteger_deproteger.xls
et j'utilise motdepasse comme password.

Dans le classeur EssaiMDP.xls j’ai mis le code comme ci-dessous.
Jai ajouté l’ouverture, et l’activation du classeur Proteger_deproteger.xls

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
45
46
47
 
'code de Blondelle
 
Sub TestProtect()
Workbooks.Open "c:\Temp\Proteger_deproteger.xls"
Workbooks("Proteger_deproteger.xls").Activate
ProtectVBProject Workbooks("Proteger_deproteger.xls"), "motdepasse"
Workbooks("Proteger_deproteger.xls").Close
End Sub
 
Sub TestUnprotect()
Workbooks.Open "c:\Temp\Proteger_deproteger.xls"
Workbooks("Proteger_deproteger.xls").Activate
UnprotectVBProject Workbooks("Proteger_deproteger.xls"), "motdepasse"
Workbooks("Proteger_deproteger.xls").Close
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

Le fichier Proteger_deproteger.xls n’est pas protégé au départ.
Je lance la macro Sub TestProtect() pas à pas avec F8
avec des contrôle dans la fenêtre « Espions » :
vbProj
Password

Lorque je déroule l’espion « vbProject » je repère des lignes qui me font supposer que c’est bien le bon fichier sur lequel je travaille :

: BuildFileName : "C:\Temp\Proteger_deproteger.DLL" : String : Module6.ProtectVBProject
: FileName : "C:\Temp\Proteger_deproteger.xls" : String : Module6.ProtectVBProject

Pour l’espion « Password » :

Watch : : Password : "motdepasse" : String : Module6.ProtectVBProject

Mais après cette ligne :

Code :

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

1
2
 
Application.VBE.CommandBars(1).FindControl(ID:=2578, recursive:=True).Execute

C’est la fenêtre « VBAProject – propriétés du projet » du classeur « EssaiMDP.xls », (qui exécute la macro), qui s’ouvre au lieu de celle du fichier « Proteger_deproteger.xls » attendu. Et si je vais dans l’onglet « Protection » il n’y a rien de noté.
D’ailleurs pourquoi cette fenêtre s’ouvre ? Si cette macro ne sert qu’à ouvrir cette fenêtre autant le faire directement dans le classeur.
Donc rien n’est fait, le fichier « Proteger_deproteger.xls » se ferme et n’est pas protégé.
Dur dur la protection déprotection du code VBA d’un classeur fermé à partir d’un autre classeur !!! Car c’est ce que je recherche depuis le début

En réponse à bbil
J’ai vérifié la référence "Microsoft Visual basic for application extensibility...."

En fait j’aimerais plutôt continuer avec ce code dont les procédures me paraissent plus claires, à mes yeux, que la première pour laquelle j’avais envoyé un S.O.S.
Il me restera à ajouter mon module au milieu quand j’aurai réussi à déprotéger et reprotéger ce classeur.

A+ si vous n’êtes pas découragés et Merci encore à vous tous.

[Globulus]

Bonjour,
J'ai exactement le même problème que martiweb: je souhaite protéger le code VBA d'un fichier depuis un autre fichier. Seule la partie protection m'intéresse, mais pour déprotéger c'est la même chose...
Bon, la discussion ne date pas d'hier, mais je souhaite apporter ma contribution.

J'ai testé le code proposé, et celui-ci fonctionne à condition de ne pas fermer le fichier à protéger (du moins pas tout de suite)
Explication :
la ligne : Set Application.VBE.ActiveVBProject = vbProj
active le fichier à protéger dans VBA.

la ligne : Application.VBE.CommandBars(1).FindControl(ID:=2578, recursive:=True).Execute
simule l'ouverture de la boite de dialogue "Propriétés de VBAProject", exactement comme si on allait dans le menu Outils/Propriétés de VBAProject...

C'est là qu'intervient l'instruction SendKeys, qui simule l'appui sur des touches (permettant de basculer sur l'onglet "Protection", cocher la case et écrire le mot de passe)
Le truc, c'est que SendKeys est lent.
Donc même en le plaçant avant Application.VBE.CommandBars... , çà fonctionne.
Sauf si après la sauvegarde (WB.Save), on ferme le fichier (du style WB.Close).
Là, du coup, Visual Basic pointe à nouveau sur le fichier contenant la macro, et c'est celui là qui se retrouve protégé.
La solution est d'utiliser l'argument Wait de l'instruction SendKeys qui attend que tous les caractères soient envoyés avant de passer à l'instruction suivante.
Par contre, il faut donc placer SendKeys après l'instruction Application.VBE.CommandBars...

Là, çà marche (chez moi en tout cas)

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
Sub TestProtect()
  ProtectVBProject Workbooks("Proteger_deproteger.xls"), "motdepasse"
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
 
  Application.VBE.CommandBars(1).FindControl(ID:=2578, recursive:=True).Execute
 
  SendKeys "+{TAB}{RIGHT}%V{+}{TAB}" & Password & "{TAB}" & Password & "~", True
 
  WB.Save
 
  WB.Close
End Sub

Je pense que Martiweb n'attend plus la solution depuis tout ce temps, mais j'espère que çà débloquera quelqu'un, un jour...

[thom07lamy]

Bonjour à tous,
je me permets de relancer le sujet car j'ai un problème lié.

J'ai un classeur 'Matrice.xls' instancié pour chaque affaire, dans lequel il y a un module 'ListeArticles'. Suite à une récente migration du serveur de données, j'ai dû changer le code de ce module...

Les utilisateurs ouvrent les différentes instances du fichier 'Matrice.xls' par un fichier 'Index.xls'...
J'y ai donc mis une macro qui remplace le module 'ListeArticles' par sa version la plus récente.
Seulement voilà, j'ai rencontré plusieurs difficultés:

1. Le projet VB de 'Matrice.xls' a été protégé par plusieurs mots de passe au fil du temps, que je connais heureusement (j'ai donc une affaire A protégée par 'Pwd1', et une affaire B protégée par 'Pwd2'.
2. Par moment mon code de déverrouillage tente d'accéder à un autre projet que celui que je veux.

Voici mon code de déprotection pour illustration:

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
Function UnprotectVBProject(WB As Workbook, ByVal Password As String) As Boolean
Dim vbProj As Object
 
Set vbProj = WB.VBProject
 
'Inutile si le projet est déjà déprotégé
If vbProj.protection <> 1 Then
    UnprotectVBProject = True
    Exit Function
Else
    Set Application.VBE.ActiveVBProject = vbProj
    'Saisie du mot de passe avec SendKeys
    Application.VBE.CommandBars(1).FindControl(ID:=2578, recursive:=True).Execute
    SendKeys Password & "~~"
    'Ajout pour sortir de la fenêtre de saisie du mot de passe au cas où Password n'est pas le bon
    SendKeys "{TAB}{TAB}~"
    If vbProj.protection <> 1 Then
        UnprotectVBProject = True
    Else
        UnprotectVBProject = False
    End If
End If
End Function

La ligne Sendkeys "{TAB}{TAB}~", que j'ai ajoutée pour pouvoir sortir de la fenêtre de saisie du mot de passe si le mot de passe n'est pas le bon, doit être celle qui pose problème... En effet, si mon mot de passe est le bon, au lieu de sortir de la fenêtre de saisie du mot de passe, je me retrouve deux projets plus bas, et la touche Entrée m'envoie directement sur la fenêtre de saisie du mot de passe...

Je ne sais pas si je suis très clair, alors je rajoute aussi mon code d'appel, peut-être que ce sera mieux:

Code :

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

1
2
3
4
5
6
7
8
9
'Ouverture du classeur de l'affaire
Set Classeur_Cible = Workbooks.Open(Filename:=cible, UpdateLinks:=0, WriteResPassword:=code1, IgnoreReadOnlyRecommended:=True)
Deverrouill_Classeur = UnprotectVBProject(Classeur_Cible, Pwd1)
DoEvents
If Deverrouill_Classeur = False Then
    'Si le mot de passe est refusé, c'est que l'affaire est trop ancienne, on doit alors utiliser l'ancien mot de passe
    Deverrouill_Classeur = UnprotectVBProject(Classeur_Cible, Pwd2)
    DoEvents
End If

Mon problème est plus un désagrément qu'un bug (un clic sur 'Annuler' et le code poursuit son exécution sans problème), mais j'aimerais que tout soit transparent pour l'utilisateur.
Je pense que la solution serait de déclencher le Sendkeys "{TAB}{TAB}~" seulement si on est toujours sur la fenêtre de saisie du mot de passe après la première tentative de mot de passe, mais j'ignore comment faire...

Désolé pour le roman, et merci d'avance à ceux qui pourront m'aider.

[thom07lamy]

En cherchant chez nos amis anglophones, j'ai peut-être trouvé la solution à mon problème.
Voici la nouvelle fonction:

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
 
Function UnprotectVBProject(WB As Workbook, ByVal Password As String) As Boolean
Dim vbProj As Object
 
Set vbProj = WB.VBProject
 
'Inutile si le projet est déjà déprotégé
If vbProj.protection <> 1 Then
    UnprotectVBProject = True
    Exit Function
Else
    Set Application.VBE.ActiveVBProject = vbProj
    'Saisie du mot de passe avec SendKeys, {ESC} sort de la fenêtre de saisie du mot de passe
    SendKeys Password & "~~" & "{ESC}"
    Application.VBE.CommandBars(1).FindControl(ID:=2578, recursive:=True).Execute
    If vbProj.protection <> 1 Then
        UnprotectVBProject = True
    Else
        'Password n'est pas le bon
        UnprotectVBProject = False
        SendKeys "%{F11}", True
    End If
End If
End Function

Le {ESC} était la solution depuis le début...
Par contre, un truc que je ne comprends pas, mon code fonctionne sur la plupart des PCs, mais un en particulier me pose souci, et seulement sur un appel de la fonction (pas les 3 hein, sinon ça serait trop simple...). Mais bon je ne désespère pas, je trouverai bien quelque chose.