Protéger le code vba de plusieurs classeurs Excel par mot de passe

Version imprimable

1 pièce(s) jointe(s)

Bonjour à tous,

J'ai un code qui permet de rajouter un onglet à la fin de plusieurs (environ 250) feuilles Excel.

Je voudrais à l'ouverture de chaque fichier protéger, par mot de passe, le code vba du classeur ouvert (avant ou après l'ajout du l'onglet).

Le mot de passe sera le même pour tous les fichiers.
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 Macro1() Dim Fichier As String, Chemin As String Dim Wb As Workbook Dim wbExcel As Workbook 'Définit le répertoire contenant les fichiers Chemin = "C:\Users\bas\Desktop\TESTS\onglet\" Fichier = Dir(Chemin & "*.xlsm") ' Permet de masquer les fenetres d'alertes de liaison Application.ScreenUpdating = False Application.AskToUpdateLinks = False 'Boucle sur tous les fichiers xlsm du répertoire. Do While Fichier <> "" Set Wb = Workbooks.Open(Chemin & Fichier, UpdateLinks:=0) ' Copie de l'onglet info et enregistrement sur la feuille active ThisWorkbook.Sheets("Info").Copy After:=Wb.Sheets(Wb.Sheets.Count) 'INSERER ICI LE CODE POUR PROTEGER PAR MOT DE PASSE LE CODE VBA DU CLASSEUR ACTIF ActiveWorkbook.Save Wb.Close Application.ScreenUpdating = True Set Wb = Nothing Fichier = Dir Loop End Sub
En d'autre terme, c'est traduire en code vba la propriété ci-dessousPièce jointe 160101

code trouvé

J'ai trouvé un code ici:
http://www.developpez.net/forums/d24...r/#post5394064

que j'ai intégré ainsi mais ça ne marche pas, qui peut me dire dire svp ? (suis un débutant !)

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
45
46
47
48
49
50
51
52
53
54
55
56
57
Sub Macro1()
 
Dim Fichier As String, Chemin As String
Dim WB As Workbook
Dim wbExcel As Workbook
 
'Définit le répertoire contenant les fichiers
 
    Chemin = "C:\Users\bas\Desktop\TESTS\onglet\"
    Fichier = Dir(Chemin & "*.xlsm")
 
 ' Permet de masquer les fenetres d'alertes de liaison
        Application.ScreenUpdating = False
        Application.AskToUpdateLinks = False
 
'Boucle sur tous les fichiers xlsm du répertoire.
    Do While Fichier <> ""
        Set WB = Workbooks.Open(Chemin & Fichier, UpdateLinks:=0)
 
' Copie de l'onglet info et enregistrement sur la feuille active
        ThisWorkbook.Sheets("Info").Copy After:=WB.Sheets(WB.Sheets.Count)
 
        ProtectVBProject WB, "Hassan"
 
 
        ActiveWorkbook.Save
        WB.Close
        Application.ScreenUpdating = True
        Set WB = Nothing
        Fichier = Dir
 
    Loop
End Sub
 
 
Sub ProtectVBProject(WB1 As Workbook, ByVal Password As String)
  Dim vbProj As Object
 
  Set vbProj = WB1.VBProject
 
   If vbProj.Protection = 1 Then Exit Sub
 
   ' Active le fichier à protéger dans VBA
 
  Set Application.VBE.ActiveVBProject = vbProj
 
  ' 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...
 
  Application.VBE.CommandBars(1).FindControl(ID:=2578, recursive:=True).Execute
 
  ' simule l'appui sur des touches (permettant de basculer sur l'onglet "Protection", cocher la case et écrire le mot de passe)
  SendKeys "+{TAB}{RIGHT}%V{+}{TAB}" & Password & "{TAB}" & Password & "~", True
 
  WB1.Save
 
  WB1.Close
End Sub

Bonjour,

Pour moi, tu t'es trompé en recopiant le code trouvé, j'utilise le même chez moi, et c'est parfaitement fonctionnel, par contre chez moi, ces deux lignes de ton code, sont inversées :

Code:

1
2
3
4
Application.VBE.CommandBars(1).FindControl(ID:=2578, recursive:=True).Execute
 
  ' simule l'appui sur des touches (permettant de basculer sur l'onglet "Protection", cocher la case et écrire le mot de passe)
  SendKeys "+{TAB}{RIGHT}%V{+}{TAB}" & Password & "{TAB}" & Password & "~", True

chez moi :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
Sub ProtectVBProject(WB As Workbook, ByVal Password As String)

  Dim vbProj As Object

  Set vbProj = WB.VBProject

  'can't do it if already locked!
  'Ne peut pas le faire si déjà fermé!
  If vbProj.Protection = 1 Then Exit Sub

  Set Application.VBE.ActiveVBProject = vbProj

  ' now use lovely SendKeys to set the project password
  ' Employez maintenant l'instruction SendKeys pour mettre le mot de passe du projet

  SendKeys "+{TAB}{RIGHT}%V{+}{TAB}" & Password & "{TAB}" & _
Password & "~"

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

  WB.Save
  
End Sub

Le problème vient peut-être de la...

29/10/2014, 14h04
Nico Chg

Bonjour,

Je passe rapidement pour dire que les protections mise en place par Microsoft Office sont ... pas très protectrices ! Avec un peu d'astuces (et une bonne recherche google) n'importe qui peut faire sauter ces mots de passe très rapidement (pas de passage en force brute). Il suffit simplement de modifier l'archive !

code

Bonjour,

Merci de vos messages.

J'ai inversé les deux lignes mais ça me fait la même chose: il me protège seulement le fichier où il y'a la macro et pas les autres alors que moi je voulais l'inverse

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
45
46
47
48
49
50
51
52
53
54
55
56
57
58
Sub Macro1()
 
Dim Fichier As String, Chemin As String
Dim WB As Workbook
Dim wbExcel As Workbook
 
'Définit le répertoire contenant les fichiers
 
    Chemin = "C:\Users\bas\Desktop\TESTS\onglet\"
    Fichier = Dir(Chemin & "*.xlsm")
 
 ' Permet de masquer les fenetres d'alertes de liaison
        Application.ScreenUpdating = False
        Application.AskToUpdateLinks = False
 
'Boucle sur tous les fichiers xlsm du répertoire.
    Do While Fichier <> ""
    If Fichier <> ThisWorkbook.Name Then
        Set WB = Workbooks.Open(Chemin & Fichier, UpdateLinks:=0)
 
' Copie de l'onglet info et enregistrement sur la feuille active
        ThisWorkbook.Sheets("Info").Copy After:=WB.Sheets(WB.Sheets.Count)
 
        ProtectVBProject WB, "hassan"
 
        ActiveWorkbook.Save
'        WB.Close
        Application.ScreenUpdating = True
        Set WB = Nothing
 
        End If
        Fichier = Dir
    Loop
End Sub
 
 
Sub ProtectVBProject(WB1 As Workbook, ByVal Password As String)
  Dim vbProj As Object
 
  Set vbProj = WB1.VBProject
 
   If vbProj.Protection = 1 Then Exit Sub
 
   ' Active le fichier à protéger dans VBA
 
  Set Application.VBE.ActiveVBProject = vbProj
 
    ' 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...
 
  Application.VBE.CommandBars(1).FindControl(ID:=2578, recursive:=True).Execute
 
  ' simule l'appui sur des touches (permettant de basculer sur l'onglet "Protection", cocher la case et écrire le mot de passe)
  SendKeys "+{TAB}{RIGHT}%V{+}{TAB}" & Password & "{TAB}" & Password & "~", True
 
  WB1.Save
 
  WB1.Close
End Sub

30/10/2014, 14h01
Zirak

Bonjour,

Sur le code que tu as remis dans ton dernier message, les lignes ne sont toujours pas inversées, attention.

Demain en rentrant chez moi après le travail, je me créerais des classeurs fictifs pour tester et voir où cela bloque si tu dis que cela ne fonctionne toujours pas, car la comme ça je ne vois pas.

Ceci dit, c'est vrai que je n'utilisais ces procédures que sur le classeur qui les contenaient, donc je sais qu'elles fonctionnent, mais du fait de vouloir les appliquer sur un autre classeur, il y a peut-être une interaction supplémentaire à prendre en compte, mais sans tester, je peux difficilement te dire quoi.

Bonjour,

Avec cette version ça marche sur tous les classeurs du dossier sauf le premier.
et au lieu du premier, il me sécurise le fichier de base (où il y'a la macro).

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
45
46
47
48
49
50
51
52
53
54
55
56
57
Sub Macro1()
 
Dim Fichier As String, Chemin As String
Dim WB As Workbook
 
'Définit le répertoire contenant les fichiers
 
    Chemin = "C:\Users\bas\Desktop\TESTS\onglet\"
    Fichier = Dir(Chemin & "*.xlsm")
 
 ' Permet de masquer les fenetres d'alertes de liaison
        Application.ScreenUpdating = False
        Application.AskToUpdateLinks = False
 
'Boucle sur tous les fichiers xlsm du répertoire.
    Do While Fichier <> ""
    If Fichier <> ThisWorkbook.Name Then
        Set WB = Workbooks.Open(Chemin & Fichier, UpdateLinks:=0)
 
' Copie de l'onglet info et enregistrement sur la feuille active
  ''' ThisWorkbook.Sheets("Info").Copy After:=WB.Sheets(WB.Sheets.Count)
 
       ActiveWorkbook.Save
      MsgBox ActiveWorkbook.Name
       ProtectVBProject WB, "serigne"
       Application.ScreenUpdating = True
 
        Set WB = Nothing
 
    End If
        Fichier = Dir
    Loop
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
 
   ' Active le fichier à protéger dans VBA
 
  Set Application.VBE.ActiveVBProject = vbProj
 
    ' 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...
 
  Application.VBE.CommandBars(1).FindControl(ID:=2578, recursive:=True).Execute
 
  ' simule l'appui sur des touches (permettant de basculer sur l'onglet "Protection", cocher la case et écrire le mot de passe)
  SendKeys "+{TAB}{RIGHT}%V{+}{TAB}" & Password & "{TAB}" & Password & "~", True
 
  WB.Save
 
  WB.Close
End Sub