Ajouter une macro par macro dans ThisWorkbook

Bonsoir,

Si je place les deux fichiers ci-joints dans le même dossier, que j’ouvre le ‘’Fichier 1’’ et que je lance la macro en place derrière le bouton ‘’Liste CdC’’, un nouveau ‘’Fichier 3’’ est créé sur la base d’une des feuilles du ‘’Fichier 2’’ (ouvert et refermé en cours d’exécution).

Je souhaiterais pouvoir inscrire un code Private Sub Workbook_Open() dans ‘’ThisWorkbook’’ du nouveau ‘’Fichier 3’’.

J’ai trouvé beaucoup d’informations afin d’ajouter – par une autre macro - une macro dans un module ou dans le code d’une feuille, mais non pas dans ‘’ThisWorkbook’’.

Savez-vous comment je dois m’y prendre.

Amicalement.

32fichier-2.xlsm (107.89 Ko)
23fichier-1.zip (46.00 Ko)

Bonjour Yvouille,

Tu peux accéder au code VBA de ThisWorkbook d'un classeur comme ceci :

Sub lecture_macro_thisworkbook()
    Dim i As Integer
    For i = 1 To ThisWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule.CountOfLines
        Debug.Print ThisWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule.Lines(i, 1)
    Next
End Sub

Trouve un exemple complet ci-dessous ...

C'est boxing day (ou St Etienne) en Suisse comme en Angleterre ?

Pour la recopie, tu peux faire:

Sub dupliquer()
' cocher la réference Microsoft Visual Basic for Applications Extensibility 5.3
Dim myMacroThisWorkbook As VBComponent

    Set myMacroThisWorkbook = ThisWorkbook.VBProject.VBComponents("ThisWorkbook")
    Workbooks.Add
    RecopierMacro myMacroThisWorkbook, ActiveWorkbook.VBProject.VBComponents("ThisWorkbook")

End Sub

Sub RecopierMacro(depuis As VBComponent, jusque As VBComponent)
    With jusque.CodeModule
        For i = 1 To depuis.CodeModule.CountOfLines
            .InsertLines i, depuis.CodeModule.Lines(i, 1)
        Next
    End With
End Sub

Salut Steelson,

Merci beaucoup pour ta réponse.

Ton code permet de lire une macro dans ThisWorkbook, mais moi je voudrais aller en y inscrire une.

Très rapidement, j'ai tenté d'écrire

ActiveWorkbook.VBProject.VBComponents("ThisWorkbook").Lines(1, 1) = "Sub xx ()"

mais ça ne passe pas.

Je n'ai plus le temps de faire plus d'essais avant ce soir, mais je ne pense pas que je vais réussir facilement. As-tu une idée de comment m'y prendre ?

Très bonne journée.

Oui

regarde l'exemple que je viens de poster et de modifier ... il est fonctionnel, je viens de le tester

je pense qu'il faut faire insertLines

récupère le module, ce sera plus simple (si j'ai le temps, je l'adapterais à ton fichier si besoin mais tu es au moins aussi à l'aise voire plus que moi en VBA)

L'exemple ci-avant est fait pour dupliquer

Pour créer, voici un code qui je pense devrait fonctionner

Sub AjouterMacro()
' cocher la réference Microsoft Visual Basic for Applications Extensibility 5.3
    With ActiveWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule
        ligne = .CountOfLines
        .InsertLines ligne + 1, "Private Sub Workbook_Open()"
        .InsertLines ligne + 2, "' mon code ici"
        .InsertLines ligne + 3, "End Sub"
    End With
End Sub

Salut Steelson,

Un tout grand merci pour ton aide. J’ai maintenant eu le temps de tester tout ça.

Tes deux propositions fonctionnent très bien, mais …….

En fait, la solution qui me plairait le plus serait de pouvoir écrire un code. J’ai réussi à utiliser ton dernier exemple, mais ça se complique lorsque je veux insérer une MsgBox. Il y a effectivement un problème vu le nombre de guillemets.

capture

J’ai essayé de mettre des parenthèses, mais sans succès.

.InsertLines ligne + 2, "MsgBox ("Attention !")"

Je me suis alors dit que je pouvais utiliser ton autre proposition, mais – dans mon fichier réel de base - j’ai déjà du code dans Thisworkbook, code qui fait appel à une macro disparue dans le fichier nouvellement créé (Fichier 3 dans mes exemples pour ce fil). Et ceci malgré le fait que j’ai placé un passage spécial en début de code, comme ci-dessous.

Private Sub Workbook_Open()
Dim i As Integer

If ActiveWorkbook.Name = "Fichier 3" Then
    MsgBox "Attention !"
    Exit Sub
End If

Call Macro_disparue

End Sub

Je pense donc qu’il y a deux solutions, mais je n’en connais l'application d’aucune : a) soit il y a une possibilité de contourner ce problème de guillemets afin que la ligne en rouge dans mon image passe, soit b) je pourrais placer dans le fichier de base un UserForm qui comporterait mon message ‘’Attention !’’, un code le copierait-collerait dans le Fichier 3 nouvellement créé et un autre code écrirait une macro sans guillemets dans ThisWorkbook, macro qui ouvrirait ce UserForm à l’ouverture du Fichier 3.

Très facile à dire, mais plus dur à réaliser, ou bien ?

Bonjour Yvouille,

il faut juste doubler les guillemets ! (attention, il y en a donc 3 au bout de la ligne ...)

.InsertLines ligne + 2, "MsgBox ""Attention !"""

Bonjour,

Pour l'ajout d'un message :

Sub AjouterMacro()
' cocher la r?ference Microsoft Visual Basic for Applications Extensibility 5.3
    With ActiveWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule
        ligne = .CountOfLines
        .InsertLines ligne + 1, "Private Sub Workbook_Open()"
        .InsertLines ligne + 2, "    MsgBox ""Impossible d'activer Feuil1."""
        .InsertLines ligne + 3, "End Sub"
    End With
End Sub

Merci à tous deux pour vos réponses matinales et .... si rapprochées

Ca fonctionne à merveille mais je tombe à nouveau sur la prochaine (mauvaise) surprise.

Le texte que je voudrais faire apparaître dans mon MsgBox contient des retours à la ligne et mon instruction ci-dessous ne donne pas le résultat désiré :

        .InsertLines Ligne + 2, "    MsgBox ""ATTENTION !" & vbNewLine & vbNewLine _
        & "Cette liste date déjà du " & Range("Z1") & "."""

Voici ce que j'obtiens :

2018 12 27 14 17 36

Est-ce à nouveau une question de "" à mettre au bon endroit ? J'ai essayé un ou deux trucs, mais rien de concluant

A vous relire.

BOnjour à tous et bonnes fêtes ....

un essai sans avoir préalablement fait le test :

        .InsertLines Ligne + 2, "    MsgBox ""ATTENTION !"" & vbNewLine & vbNewLine _
        & ""Cette liste date déjà du "" & Range(""Z1"") & ""."""

j'ai cependant un doute avec le range(""Z1"")

Fred

Yvouille,

Sub AjouterMacro()
' cocher la réference Microsoft Visual Basic for Applications Extensibility 5.3
    With ActiveWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule
        Ligne = .CountOfLines
        .InsertLines Ligne + 1, "Private Sub Workbook_Open()"
        .InsertLines Ligne + 2, "MsgBox ""ATTENTION !"" & vbCrLf & ""Cette liste date déjà du "" & Range(""Z1"") & "" !"
        .InsertLines Ligne + 3, "End Sub"
    End With
End Sub

Bonjour,

A adapter.

Cdlt.

6yvouille.xlsm (17.81 Ko)
Option Explicit
' cocher la réference Microsoft Visual Basic for Applications Extensibility 5.3
Sub AjouterMacro()
Dim strDate As String, Ligne As Long
    strDate = Format(Date, "dd.mm.yyyy.")
    With ActiveWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule
        Ligne = .CountOfLines
        .InsertLines Ligne + 1, "Private Sub Workbook_Open()"
        .InsertLines Ligne + 2, "    MsgBox ""Impossible d'activer Feuil1."" & vbNewLine & vbnewline & ""Cette liste date déjà du " & strDate & ""
        .InsertLines Ligne + 3, "End Sub"
    End With
End Sub

Bonjour à vous trois et un tout grand merci à chacun pour son aide.

@ Fred

Ta solution ne passe malheureusement pas. Ta ligne s'inscrit en rouge lorsque je la place dans mon code de base. Je suis arrivé à la faire venir en noir en modifiant l'ordre des guillemets, mais ça bloque alors plus loin, lorsque la macro souhaitée est inscrite dans ThisWorkbook Bon, je n'ai pas cherché plus que tant non plus, puisque j'avais la solution à mon problème.

@ Steelson et Jean-Eric

Vos deux solutions fonctionnent indifférement très bien. J'ai juste dû corriger la moindre le code de Jean-Eric car je souhaite vraiment indiquer une date figée en Z1. Mais il y avait juste cette ligne à adapter :

strDate = Format(Range("Z1"), "dd.mm.yyyy.")

Cette fois je pense que ce souci est définitivement résolu. Grâce à votre aide

Très cordialement.

Je reconnais que ce n'est pas très évident à écrire !

Un moyen simple est d'écrire d'abord l’instruction

Sub TEST()
    MsgBox "ATTENTION !" & vbCrLf & vbCrLf & "Cette liste date déjà du " & Range("Z1") & " !"
End Sub

et ensuite l'encadrer avec "_______" en doublant les guillemets

Sub AjouterMacro()
' cocher la réference Microsoft Visual Basic for Applications Extensibility 5.3
    With ActiveWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule
        Ligne = .CountOfLines
        .InsertLines Ligne + 1, "Private Sub Workbook_Open()"
        .InsertLines Ligne + 2, "MsgBox ""ATTENTION !"" & vbCrLf & vbCrLf & ""Cette liste date déjà du "" & Range(""Z1"") & "" !"
        .InsertLines Ligne + 3, "End Sub"
    End With
End Sub

Maintenant tu as sans doute raison de figer cette valeur (mais elle n'est quand même lue qu'à l'ouverture)

Normalement, le

Ligne = .CountOfLines

que j'avais indiqué est inutile car on part d'un module vierge, mais dans d'autres cas ce serait indispensable ... cela ne mange pas de pain de le laisser même si c'est superflu !

J’ai trouvé beaucoup d’informations afin d’ajouter – par une autre macro - une macro dans un module ou dans le code d’une feuille, mais non pas dans ‘’ThisWorkbook’’.

Comme quoi on est les meilleurs !! (en toute modestie)

Merci Steelson pour ce petit ''truc'' d'écriture

Maintenant tu as sans doute raison de figer cette valeur (mais elle n'est quand même lue qu'à l'ouverture)

Euh, je ne sais pas si tu m'as bien compris : j'ai donné l'information sur la date figée à Jean-Eric car il avait remplacé mon Range("Z1") par Date, mais toi tu avais bien laissé la référence à la cellule Z1.

Effectivement que cette information n'est donnée qu'à l'ouverture du fichier, mais c'est justement ce que je souhaitais réaliser.

Encore une fois merci pour toute l'aide reçue.

Rechercher des sujets similaires à "ajouter macro thisworkbook"