Discussion :

[BAPOULA]

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 :

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

[BAPOULA]

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 :

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

[Zirak]

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 :

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

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 :

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

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

[BAPOULA]

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 :

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

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

[BAPOULA]

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 :

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