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
| Sub UpdateFichier()
Dim Wb As Workbook
Dim VbComp As VBComponent
Set Srcwb = ActiveWorkbook ' Fichier contenant le nouveau code VBA
On Error Resume Next
'Export userform Source
For Each VbComp In Srcwb.VBProject.VBComponents
If VbComp.Type = 3 Then VbComp.Export VbComp.Name & ".frm"
Next
'**********************************************************************************************
' C'est simplifié pour l'exemple, ma macro complète exécute la mise à jour sur tous les fichiers d'un répertoire
' Je n'ai mis que le code de mise à jour des sheets (la partie module et userform fonctionne bien)
Workbooks.Open Filename:= _
"U:\Repertoire\Fichier_Destination.xlsm", _
UpdateLinks:=0
Set Wb = Workbooks("Fichier_Destination.xlsm")
' Je renomme les modules et les userforms avec un préfixe zz_ je vide les modules de leurs code et je les supprime
For Each VbComp In Wb.VBProject.VBComponents
Select Case VbComp.Type
Case 1 ' Suppression des 1 = Modules
VbComp.Name = "zz_" & VbComp.Name
With VbComp.CodeModule
.DeleteLines 1, .CountOfLines
End With
wb.VBProject.VBComponents.Remove VbComp
Case 3 ' Suppression 3 = Userform
VbComp.Name = "zz_" & VbComp.Name
wb.VBProject.VBComponents.Remove VbComp
Case 100 ' Code VBA des Sheets supprimés
With VbComp.CodeModule
.DeleteLines 1, .CountOfLines
End With
End Select
Next
'Dans un 2ème temps remplacement dans chacune des feuilles du fichier destination du code présent dans le fichier source (les 2 fichiers ont les mêmes sheets présents)
For Each VbComp In Srcwb.VBProject.VBComponents
Select Case VbComp.Type
Case 1 ' 1 = Modules, Création du module(même nom que Src) et copie du code Src
Set VbDest = wb.VBProject.VBComponents.Add(1)
VbDest.Name = VbComp.Name
With VbComp.CodeModule
CodeModSrc = .Lines(1, .CountOfLines)
End With
VbDest.CodeModule.InsertLines 1, CodeModSrc
CodeModSrc = ""
Case 3 ' 3 = userform, Importation des userform Sources
wb.VBProject.VBComponents.Import VbComp.Name & ".frm"
Case 100 ' Réécriture du Code VBA des Sheets par rapport à la source
With VbComp.CodeModule
CodeModSrc = .Lines(1, .CountOfLines + 1)
End With
wb.VBProject.VBComponents(VbComp.Name).CodeModule.InsertLines 1, CodeModSrc
CodeModSrc = ""
End Select
Next
Application.EnableEvents = False
Wb.Close SaveChanges:=True
Application.EnableEvents = True
End Sub |
Partager