Boostez vos compétences Excel avec notre communauté !
Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !
'Copie_texte_VBA_dans_Module thisWorkbook de fichier 1 à fichier2
Sub AjouterCode_Bis()
'Stop
Dim iajcode As Byte
NomAct = ThisWorkbook.Name '"fichier1.xls"
NomAct2 = ActiveWorkbook.Name '"Fichier2.xls"
iajcode = Workbooks(NomAct).VBProject.VBComponents("Thisworkbook").CodeModule.CountOfLines
Workbooks(NomAct2).VBProject.VBComponents("Thisworkbook").CodeModule.AddFromString Workbooks(NomAct).VBProject.VBComponents("Thisworkbook").CodeModule.Lines(1, iajcode)
End SubSub Test()
Dim Dossier As String
Dim Chemin As String
Dim NouveauModule As String
Dim AncienModule As String
Dim Tbl() As String
Dim I As Integer
'dossier où sont les classeurs à modifier
Dossier = "E:\Mon Dossier\"
'récupère le nom de tous les classeurs
Tbl = RecupFichiers(Dossier)
NouveauModule = "Module3" '<-- nom du module à exporter et importer
AncienModule = "Module2" '<-- nom du module à supprimer le cas échéant !
'module de mise à jour
Chemin = ThisWorkbook.Path & "\" & NouveauModule & ".bas"
'exporte le module dans le dossier du classeur actif, ne doit pas se trouver
'dans le même dossier que les classeurs à mettre à jour
ThisWorkbook.VBProject.VBComponents(NouveauModule).Export Chemin
Application.ScreenUpdating = False
'boucle sur les classeurs
For I = 1 To UBound(Tbl)
'ouvre le classeur cible, supprime l'ancier module et importe le nouveau
With Workbooks.Open(Dossier & Tbl(I)).VBProject.VBComponents
.Remove VBPAncienMod.VBComponents(AncienModule)
.Import Chemin
End With
'enregistre et ferme
Workbooks(Dossier & Tbl(I)).Save
Workbooks(Dossier & Tbl(I)).Close
'passe au suivant !
Next I
Application.ScreenUpdating = True
'supprime le module du dossier
Kill Chemin
End Sub
Function RecupFichiers(Chemin As String) As String()
Dim TableauFichiers() As String
Dim Fichier As String
Dim I As Integer
'boucle dans le dossier jusqu'à la fin des fichiers et rempli le tableau
Fichier = Dir(Chemin & "*.xls")
Do While (Len(Fichier) > 0)
I = I + 1
ReDim Preserve TableauFichiers(1 To I)
TableauFichiers(I) = Fichier
Fichier = Dir()
Loop
RecupFichiers = TableauFichiers()
End Function
