[XL-2010] Projet VBA impossible à déverrouiller via une macro

Bonjour,

après moultes recherches sur les forums, je bloque sur le déverrouillage du projet VBA de mes fichiers (environ 500) afin d'y remplacer un module VBA.
J'ai fais un condensé des codes vba trouvés :
dans une boucle sur les fichiers présents dans un répertoire :

une proc permettant de déverrouiller le projet VBA du fichier ouvert
une proc permettant de remplacer un module dans un projet VBA : fonctionnement OK

Le souci : la proc de déverrouillage ne fonctionne pas : la routine tourne bien et passe au fichier suivant.
Le code est :

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
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
Sub ImportModuleDansClasseurs()
 
    Dim Cls As Workbook
    Dim TestMod As Object
    Dim Tbl
    Dim Chemin As String
    Dim NomModule As String, Password As String
    Dim i As Integer
 
    NomModule = "Module1" 'adapter le nom du module à exporter dans le dossier du classeur contenant cette macro
    Password = "Gestion2011" ' mot de passe des fichiers à traiter
 
    'Le module est exporté dans le dossier contenant tous les classeurs (y compris celui contenant cette macro)
    Chemin = ThisWorkbook.Path & "\" & NomModule & ".bas"
 
    'exporte le module
    ThisWorkbook.VBProject.VBComponents(NomModule).Export Chemin
 
    'Récupère le chemin et nom des différents classeurs .xls et .xlsm
    'les classeurs sont dans le même dossier que le classeur contenant cette macro
    Tbl = RecupFichiers(ThisWorkbook.Path & "\", ThisWorkbook.Name)
 
    'évite les éventuelles boites de message
    Application.DisplayAlerts = False
 
    'Boucle sur les fichiers du répertoire
    For i = 1 To UBound(Tbl)
 
        Set Cls = Workbooks.Open(Tbl(i))
 
        Deverrouill_Classeur = UnprotectVBProject(Cls, Password)
 
        'Teste si le module est déjà présent dans le classeur ou si un module porte déjà ce nom
        On Error Resume Next
 
        Set TestMod = Cls.VBProject.VBComponents(NomModule)
 
        'si pas d'erreur, le module existe demande alors si on veux le remplacer
        'dans la négative, il sera renommé en "MonModule1" ou "MonModule2" etc...
        'sinon, le module existant sera supprimé et remplacé par le nouveau
        If Err.Number = 0 Then
 
            'If MsgBox("Le module '" & NomModule & "' existe déjà dans le classeur '" & Cls.Name & "' !" _
            '          & vbCrLf _
            '          & vbCrLf _
            '          & "Voulez-vous le remplacer ?", _
            '          vbQuestion + vbYesNo) = vbYes Then
            '
            Cls.VBProject.VBComponents.Remove TestMod 'supprime le module
 
            'End If
 
            Err.Clear
 
        End If
 
    Cls.VBProject.VBComponents.Import Chemin 'importe le module
    Cls.Close True 'enregistre et ferme
 
    Next i
 
    'Rétabli les alertes
    Application.DisplayAlerts = True
 
End Sub
Function RecupFichiers(Chemin As String, NomClasseur As String) As String()
'==========================================================================
'     Liste des classeurs à traiter dans ce répertoire
'==========================================================================
    Dim TableauFichiers() As String
    Dim Fichier As String
    Dim i As Integer
 
    Fichier = Dir(Chemin & "*.xls*")
 
    Do While (Len(Fichier) > 0)
 
        If Right(Fichier, 5) <> ".xlsx" And Fichier <> NomClasseur Then 'évite les ".xlsx et ce classeur"
 
            i = i + 1
 
            ReDim Preserve TableauFichiers(1 To i)
 
            TableauFichiers(i) = Chemin & Fichier
 
        End If
 
        Fichier = Dir()
 
    Loop
 
    RecupFichiers = TableauFichiers()
 
End Function
Function UnprotectVBProject(Cls As Workbook, ByVal Password As String) As Boolean
'==========================================================================
'     Déverrouillage du projet VBA du classeur en traitement
'==========================================================================
 
Dim vbProj As Object
 
    Set vbProj = Cls.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

Auriez-vous une idée du code manquant/erroné ?
Les fichiers dont j'ai enlevé le verrou au préalable sont bien traités et pas les fichiers verrouillés. La procédure se déroule sans plantage.

Cdt
Dadu