[XL-2010] Suppression module(.bas, .frm et .cls)

Bonjour,

Grâce à différentes recherches sur le forum, j'ai réussi à faire une fonction de mise à jour des modules contenus dans mon projet excel.

L'importation des données fonctionne, mais c'est la suppression qui me semble aléatoire. Seule une partie des modules sont effacés.
Pouvez-vous m'aider à les effacer à coup sûr ou bien Est-ce possible de les vider pour qu'il n'y ai pas de probleme avec les fonction en double ?

voici mon code :
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
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
 
Option Explicit
 
Sub MiseAJourModules()
 
    'InitVariablesPublic
 
    Dim CheminMAJ As String
    Dim nbmod As Integer
    Dim NomModule As String
    Dim vbComp As VBComponent
    Dim ExisteBak As Boolean
 
    CheminMAJ = LitDansFichierIni("chemin", "maj", CHEMIN_INI) & "\"
 
    If CheminMAJ = "\" Then
        MsgBox "Veuillez vérifier les paramètres de l'application.", vbCritical, "Chemin manquant"
        'Ouvre la fenètre de paramètrage du projet
        Load Frm_Parametres
        Frm_Parametres.Show
        Exit Sub
    End If
 
    If Dir(CheminMAJ & "maj.ini") = "" Then
        'Pas de mise à jour disponible
        MsgBox "Pas de mise à jour disponible"
        Exit Sub
    Else
        'Est-ce que ma version est la meme que celle qui est à mettre à jour ?
        Dim VersionAJour As String
        VersionAJour = LitDansFichierIni("MiseAJour", "Version", CheminMAJ & "maj.ini")
        If VersionAJour = VERSION_ITP Then
            'Les versions sont identique pas besoin de mise à jour
            MsgBox "Votre version est à jour."
            Exit Sub
        End If
    End If
    If ThisWorkbook.VBProject.Protection = 1 Then 
             UnProtectProjectVBA
    End if
    If ThisWorkbook.VBProject.Protection <> 1 Then
        MsgBox "Une mise à jour de l'application est diponible sur le serveur." & Chr(10) & _
            "Celle-ci va s'installer automatiquement." & Chr(10) & _
            "Une fois la mise à jour faite, l'application redémarra." _
            , vbInformation, "Mise à jour disponible"
    Else
        MsgBox "La mise à jour a échouée. Un nouvel essais sera effectué au prochain redémarrage de l'application", vbInformation, "Erreur lors de la mise à jour"
        Exit Sub
    End If
 
    'Est-ce une mise à jour de module ou une refonte ? (Refonte = réinstaller le projet)
    If LitDansFichierIni("MiseAJour", "Refonte", CheminMAJ & "maj.ini") = "OUI" Then
        Dim Shell As Object
        Dim id As Variant
        Set Shell = CreateObject("Wscript.shell")
        id = Shell.Run(Chr(34) & Shell.SpecialFolders("MyDocuments") & "\ITP Application\Program\install-ITP-Excel.vbs" & Chr(34))
        Exit Sub
    End If
 
    On Error GoTo ERR:
        For Each vbComp In ActiveWorkbook.VBProject.VBComponents            
            Application.ScreenUpdating = False
 
            Select Case vbComp.Type
                Case 1
                    'Type module (.bas)
                    If vbComp.Name <> "Mod_Update" Then
                        If Dir(CheminMAJ & vbComp.Name & ".bas") <> "" Then
                            With ThisWorkbook.VBProject.VBComponents
                                NomModule = vbComp.Name
 
                                'Renomme le module à supprimer pour que lors de l'importation le 1 ne s'ajoute pas
                                vbComp.Name = NomModule & "bak"
 
                                'Supprime l'ancienne version du module
                                DeleteModule vbComp.Name
                                ThisWorkbook.Save
 
                                'Importe la nouvelle version du module
                                .Import (CheminMAJ & NomModule & ".bas")
                            End With
                        End If
                    End If
                Case 2
                    'Type class (.cls)
                    If Dir(CheminMAJ & vbComp.Name & ".cls") <> "" Then
                        With ThisWorkbook.VBProject.VBComponents
                            NomModule = vbComp.Name
 
                            'Renomme le module à supprimer pour que lors de l'importation le 1 ne s'ajoute pas
                            vbComp.Name = NomModule & "bak"
 
                            'Supprime l'ancienne version du module
                            DeleteModule vbComp.Name
                            ThisWorkbook.Save
 
                            'Importe la nouvelle version du module
                            .Import (CheminMAJ & NomModule & ".cls")
                        End With
                    End If
                Case 3
                'type userForm (.frm)
                    If Dir(CheminMAJ & vbComp.Name & ".frm") <> "" Then
                        With ThisWorkbook.VBProject.VBComponents
                            NomModule = vbComp.Name
                           'Renomme le module à supprimer pour que lors de l'importation le 1 ne s'ajoute pas
                            vbComp.Name = NomModule & "bak"
 
                            'Supprime l'ancienne version du module
                            DeleteModule vbComp.Name
                            ThisWorkbook.Save
 
                            'Importe la nouvelle version du module
                            .Import (CheminMAJ & NomModule & ".frm")
                        End With
                    End If
                Case Else
                    'Rien
            End Select
 
        Next
 
 
        SupprModulesBak
 
        Application.ScreenUpdating = True
        'reprotège les modules
        ProtectionProjetVBA
    Exit Sub
ERR:
    Dim alog As New log
    alog.Enregistrer "Mod_Update - MiseAJourModules() - Erreur n°" & ERR.Number & " - " & ERR.Description
    ERR.Clear
 
    'Si c'est arrivé l'integrité des module n'est pas sûre. Il faut une réimportation du xlsm.
    Dim WsShell As Object
    Set WsShell = CreateObject("Wscript.shell")
    Shell.Run (Chr(34) & WsShell.SpecialFolders("MyDocuments") & "\ITP Application\Program\install-ITP-Excel.vbs" & Chr(34))
 
End Sub
 
Sub DeleteModule(Name As String)
    ThisWorkbook.VBProject.VBComponents.Remove ThisWorkbook.VBProject.VBComponents(Name)
End Sub
 
Function SupprModulesBak() As Boolean
 
    Dim nbmod
    Dim vbComp As VBComponent
    Dim ExisteBak As Boolean
 
    If ThisWorkbook.VBProject.Protection = 1 Then 
             UnProtectProjectVBA
    End if
 
 
    'On regarde si on a des suppression qui n'ont pas été effacés
    'On fait 5 boucles max...
    SupprModulesBak = True
    nbmod = 0
    Do
        nbmod = nbmod + 1
        ExisteBak = False
        For Each vbComp In ActiveWorkbook.VBProject.VBComponents
            If InStr(vbComp.Name, "bak") Then
                DeleteModule vbComp.Name
                ThisWorkbook.Save
                ExisteBak = True
            End If
        Next
    Loop Until ExisteBak = False Or nbmod > 5
    SupprModulesBak = ExisteBak
    ProtectionProjetVBA
End Function
Merci d'avance