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
| Sub PatchModule()
Dim F, FS, F1, M1
Dim VBC As Object
Dim WK As Workbook
Dim Patch As String, M As String
Dim X As Integer
M = "NouveauModule"
Patch = M & ".bas"
Set WK = ThisWorkbook
Set F = CreateObject("Scripting.FileSystemObject")
'test si le fichier "NouveauModule.bas" existe dans le dossier
If F.FileExists(ThisWorkbook.Path & "\" & Patch) Then
'si oui, récupération
Set FS = F.GetFile(ThisWorkbook.Path & "\" & Patch)
Else
' si non message d'erreur
MsgBox "Il n'y a pas de Patch [ " & Patch & " ] dans le dossier ou se trouve ce Classeur !", vbCritical
Exit Sub' la macro s'arrête
End If
With WK.VBProject
For Each VBC In .VBComponents
'test si le module "NouveauModule" existe dans les macros du classeur
If VBC.Name = M Then 'si oui
'1-suppression de la macro du classeur
WK.VBProject.VBComponents.Remove WK.VBProject.VBComponents(M)
'2-import de la nouvelle macro
WK.VBProject.VBComponents.Import ThisWorkbook.Path & "\" & Patch
'3-si un patch sauvegardé porte le même nom, création d'une nouvelle sauvegarde "anneemoisjour-patché-bis"
If F.FileExists(ThisWorkbook.Path & "\" & Year(Date) & Month(Date) & Day(Date) & "-Patché-" & Patch) Then
FS.Move ThisWorkbook.Path & "\" & Year(Date) & Month(Date) & Day(Date) & "-Patché-" & "bis-" & Patch
Else
'Sinon Sauvegarde du Patch "anneemoisjour-patché"
FS.Move ThisWorkbook.Path & "\" & Year(Date) & Month(Date) & Day(Date) & "-Patché-" & Patch
End If
MsgBox "La Macro du Classeur à été mise à jour !"
End If
Next
End With
End Sub |
Partager