Macro pour copier un code de macro

Signaler
Messages postés
12
Date d'inscription
jeudi 14 octobre 2010
Statut
Membre
Dernière intervention
25 novembre 2010
-
Messages postés
6831
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
9 juillet 2020
-
Bonjour,

Après une longue recherche sur internet, je finis encore une fois par m'adresser à vous.

J'ai fini une petite macro qui s'exécute d'un fichier excel "A" sur un autre le fichier excel "B".

Cependant, j'aimerais qu'à la fin de son exécution, un code macro me permette de copier la macro du module du fichier excel "A", automatiquement dans le module du fichier excel "B" cible.

Plus simplement, il s'agirait d'un code VBA pour copier le contenu d'un module d'un classeur, dans un module d'un autre classeur (les deux fichiers étant déjà ouverts).

En vous remerciant d'avance pour votre aide,

Herwin.

15 réponses

Messages postés
6831
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
9 juillet 2020
109
Bonjour,
J'ai trouvé ceci sur ce site, qui fonctionne:


http://frederic.sigonneau.free.fr/code/VBE/AjouterDuCodeDansUnModule.txt

'copier le code d'un module dans un autre d'un autre classeur

'ajouter le code d'une module dans le module d'une feuille
'd'un nouveau classeur
Sub AddCode()
'fs
Dim S As String, Wbk As Workbook

  With ThisWorkbook.VBProject.VBComponents("Module1").CodeModule
    S = .Lines(1, .CountOfLines)
  End With
   
  Set Wbk = Workbooks.Add
  With Wbk.VBProject.VBComponents("Feuil1").CodeModule
    .AddFromString S
  End With

End Sub 'fs

'recopier le code d'un module dans un autre classeur
'(en ajoutant d'abord un module dans cet autre classeur)
Sub CopieCodeModule()
'fs
Dim S As String, Wbk As Workbook

  With ActiveWorkbook.VBProject.VBComponents("Module1").CodeModule
    S = .Lines(1, .CountOfLines)
  End With
  
  Set Wbk = Workbooks("Classeur1.xls") 'à adapter
  Wbk.VBProject.VBComponents.Add(1).Name = "MonModule"
  With Wbk.VBProject.VBComponents("MonModule").CodeModule
    .AddFromString S
  End With

End Sub 'fs

'mettre à jour le code d'un module existant dans un autre classeur
Sub MAJCodeModule()
Dim S As String, Wbk As Workbook
  
  'module à copier
  With ActiveWorkbook.VBProject.VBComponents("Module1").CodeModule
    S = .Lines(1, .CountOfLines)
  End With
  
  Set Wbk = Workbooks("Perso.xls")
  'détruire le module à mettre à jour s'il existe
  On Error Resume Next
  With Wbk.VBProject.VBComponents
    .Remove .Item("MonModule")
  End With
  On Error GoTo 0
  'ajouter un nouveau module et copier le code
  Wbk.VBProject.VBComponents.Add(1).Name = "MonModule"
  With Wbk.VBProject.VBComponents("MonModule").CodeModule
    .AddFromString S
  End With

End Sub 'fs



Il faudra juste l'adapter en changeant le nom du classeur

@+ Le Pivert
Messages postés
12
Date d'inscription
jeudi 14 octobre 2010
Statut
Membre
Dernière intervention
25 novembre 2010

Bonjour,

cela semble correspondre exactement à ce que je recherche.

Merci beaucoup pour ton aide ! Je vais tester ça de ce pas !
Messages postés
6831
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
9 juillet 2020
109
J'ai trouvé une macro plus simple:
Tu mets cela dans un module et tu l'appelles avec: Exportermodule
Option Explicit
Sub RecopieModule()
  Dim NewM As Object, NewCode As String
  ' Stockage du code du module "Module1" du classeur maitre
    With ThisWorkbook.VBProject.VBComponents("Module1").CodeModule 'mettre le nom du module
      NewCode = .Lines(1, .CountOfLines)
    End With
  ' Ajout d'un module au CLASSEUR ACTIF
  Set NewM = ActiveWorkbook.VBProject.VBComponents.Add(1)
    With ActiveWorkbook.VBProject.VBComponents(NewM.Name).CodeModule
    ' Le DeleteLines sert à éviter éviter d'avoir 2 fois Option Explicit
    ' si la déclaration explicite est cochée dans les préférences
    'sans effet si l'option n'est pas cochée
      .DeleteLines 1, .CountOfLines
      .AddFromString NewCode
    End With
 End Sub
Sub Exportermodule()
'on ouvre le classeur cible
Workbooks.Open Filename:= _
        "Chemin du classeur.xls"
RecopieModule
End Sub


L'avantage de cette macro c'est que tu peux choisir le classeur cible.
@+ Le Pivert
Messages postés
12
Date d'inscription
jeudi 14 octobre 2010
Statut
Membre
Dernière intervention
25 novembre 2010

Rebonjour,

j'ai testé en m'aidant du troisième point, 'mettre à jour le code d'un module existant dans un autre classeur'

et ça marche d'enfer ! Merci à toi.

Cependant, il y a un point qui me pose problème.
C'est qu'avec cette macro il me semble impossible de reprendre le même nom de module que celui du fichier dont il est issu.
Or c'est justement ce que je cherche à faire.
Je veux que le module du fichier originel, puisse être copié dans un module du même nom d'un autre fichier, et ce dernier en lançant le code reproduira le même schéma (création d'un module, copie du module du fichier père vers le fichier fils ect...) et ainsi de suite sans que je doive à chaque fois intervenir dans le code.

Par exemple, dans le code exposé ci-dessus, si tu remplaces "module1" par "MonModule", le code va planter.

Erreur d'exécution '32813' :
Nom est en conflit avec un module existant, projet ou bibliothèque d'objet


Je vais donc quémander encore un peu d'aide ! A votre bon coeur !
Messages postés
6831
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
9 juillet 2020
109
Je ne comprends pas, le dernier code que je t'ai donné reproduit d'une façon identique le 1er classeur. Pourquoi passes-tu par la macro :

'mettre à jour le code d'un module existant dans un autre classeur'?

Tu peux aussi remplacer:

Sub Exportermodule()
'on ouvre le classeur cible
Workbooks.Open Filename:= _
        "Chemin du Classeur.xls"
RecopieModule
End Sub


par

Sub Exportermodule()
'on crée le classeur cible
Workbooks.Add
RecopieModule
End Sub
Messages postés
12
Date d'inscription
jeudi 14 octobre 2010
Statut
Membre
Dernière intervention
25 novembre 2010

Re et Rebonjour.

Bon problème résolu, j'ai pris la formule telle quelle
de "'mettre à jour le code d'un module existant dans un autre classeur"
et ça marche nickel !

Je ne voulais pas que le module soit effacé dans le classeur père, donc j'avais dès le début remodeler la formule en enlevant la partie
"'détruire le module à mettre à jour s'il existe"
mais en fait après avoir fait des tests, tout marche très bien et il ne supprime même pas le module du fichier père. Que du bonheur.
Donc grand merci, ça me permet de parachever ma première petite macro.

Le Pivert, je n'avais pas vu ton message lorsque j'avais répondu tout à l'heure, et comme j'étais déjà parti sur le premiers codes que tu m'avais donné je voulais explorer cette voix à fond d'autant que je suis un grand novice et que cela me prend du temps de lire de nouvelles lignes et d'essayer de les comprendre.

Merci pour tout !
Messages postés
4
Date d'inscription
jeudi 4 novembre 2010
Statut
Membre
Dernière intervention
25 novembre 2010

Bonjour

merci beaucoup pour ce post il est canon.

ce code est-il adaptable pour exporter un userform ?
Messages postés
6831
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
9 juillet 2020
109
Bonjour,
Voici un code pour exporter un userForm, 1 module et copie d'une Feuille

Sub test_Copy()
With ThisWorkbook
With .VBProject.VBComponents
With .Item("Userform1")
.Export "c:\Userform1.frm"
End With
With .Item("Module1")
.Export "c:\Module1.bas"
End With
End With
.Sheets("Feuil1").Copy
End With
Application.ScreenUpdating = False
Application.DisplayAlerts = False
With ActiveWorkbook
With .VBProject.VBComponents
.Import "c:\userform1.frm"
.Import "c:\module1.bas"
End With
.SaveAs ThisWorkbook.Path & "\Copie_userForm.xls"
.Close False
End With
Application.DisplayAlerts = True

Kill "c:\userform1.frm": Kill "c:\userform1.frx"
Kill "c:\module1.bas"
End Sub
 


Ce code crée des fichiers temporaires et les détruit ensuite. Le nouveau fichier est créé dans le dossier du classeur à copier.
A adapter suivant les besoins.

@+ Le Pivert
Messages postés
4
Date d'inscription
jeudi 4 novembre 2010
Statut
Membre
Dernière intervention
25 novembre 2010

Merci beaucoup !! Très précieux !

j'ai réussi à l'adapter et ça fonctionne nickel.

Dernière question en rapport avec ce topic, j'aimerais que dans le fichier nouvellement créé par cette macro, le module ThisWorkbook contienne du code pour qu'à la prochaine ouverture il affiche le userform que je viens d'importer.

Ca devrait donner ceci :
Private Sub Workbook_Open()
UserForm1.Show
End Sub
Messages postés
4
Date d'inscription
jeudi 4 novembre 2010
Statut
Membre
Dernière intervention
25 novembre 2010

Messages postés
12
Date d'inscription
jeudi 14 octobre 2010
Statut
Membre
Dernière intervention
25 novembre 2010

Merci pour ta réponse.

Néanmoins les codes donnés auparavant m'ont déjà permis de réaliser ce que je voulais. , merci quand même !
Messages postés
166
Date d'inscription
mercredi 23 avril 2003
Statut
Membre
Dernière intervention
16 février 2011

Bonjour,

Trés instructif ce fil, et en plus vraiment dans mon actualité.

Moi ca se passe sous Word.

J'ai créé une marco Autoclose, qui affiche une form pour que l'utilisateur saisissent quelques infos (en fait des propriétés de documents personnalisés).
Ca fonctionne.

Maintenant j'aimerais pouvoir trouvé un moyen d' "injecter" cette macro dans tous les documents word présents dans un répertoire.

Ca ne doit pas être bien loin du code ci dessous.

Si vous avez des pistes je suis preneur.

Bon WE
Messages postés
6831
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
9 juillet 2020
109
Bonjour thonyboy,
J'ai fait cela vite fait en vba Excel, je pense que tu n'auras pas de difficultés à traduire.
Donc on fait une boucle sur tous les fichiers du répertoire en copiant l'UserForm et le module dans chaque fichier:

Dim cheminfichier As String
Private Sub CommandButton1_Click()
ListFiles
End Sub
Sub test_Copy()
With ThisWorkBook
With .VBProject.VBComponents
With .Item("Userform1")
.Export "c:\Userform1.frm"
End With
With .Item("Module1")
.Export "c:\Module1.bas"
End With
End With
'.Sheets("Feuil1").Copy
.Worksheets.Copy
End With
Application.ScreenUpdating = False
Application.DisplayAlerts = False
With ActiveWorkbook
With .VBProject.VBComponents
.Import "c:\userform1.frm"
.Import "c:\module1.bas"
End With
.SaveAs cheminfichier
.Close False
End With
Application.DisplayAlerts = True

Kill "c:\userform1.frm": Kill "c:\userform1.frx"
Kill "c:\module1.bas"
End Sub
Sub ListFiles()
'   Which directory?
    Directory = "Chemin du répertoire"
'Get the files
    On Error Resume Next
    With Application.FileSearch
        .NewSearch
        .LookIn = Directory
        .Filename = "*.*"
        .SearchSubFolders = False
        .Execute
'       Write the file info
        For i = 1 To .FoundFiles.Count
            cheminfichier = .FoundFiles(i)
            test_Copy
            r = r + 1
        Next i
    End With
End Sub



@+ Le Pivert
Messages postés
166
Date d'inscription
mercredi 23 avril 2003
Statut
Membre
Dernière intervention
16 février 2011

Merci Le Pivert

Effectivement ca me semble simple a adapter.
Je vais faire le test.

En revanche je me demandais si mon AntiVirus ou même MS n'allait pas m'enquiquiner avec la sécurité, car aprés tout on injecte du code, et celui ci pourrait etre malveillant...



@+
Messages postés
6831
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
9 juillet 2020
109
J'ai testé sur Excel, il n'y a pas de problème si le niveau de sécurité des macros est réglé à Faible.De toute façon avec cette ligne de code cela supprime les alertes:
Application.DisplayAlerts = False