Copier un code dans ThisWorkbook

[creolia]

bonjour

Je souhaiterais savoir si il etait possible de copier un code dans la racine d'une feuille

en claire j'ai un code evenementiel et j'ai une macro qui me permet de creer une nouvelle feuille je cherche donc une solution pour copier un code via macro dans certaine feuille

es possible ou non merci de votre aide

 

[Robert]

Re : Copier un code dans ThisWorkbook

Bonjour Creolia, bonjour le forum,

C'est faisable mais je ne maîtrise pas du tout...
Pourquoi ne pas copier la feuille qui contient la macro événementielle ? Quitte à en effacer le contenu après plutôt que d'ajouter une feuille vierge.

 

[tbft]

Re : Copier un code dans ThisWorkbook

Bonjour

Essaye de chercher sur le forum avec suppression code VBA.
Des personnes se sont penchés sur la question de supprimer du code VBA avec une macro.
On doit pouvoir le modifier pour le copier..

Bon courage

Note la solution m'intéresse aussi....

 

[JNP]

Re : Copier un code dans ThisWorkbook

Bonjour le fil 🙂,
Teste dans un module

Sub Test()
ThisWorkbook.VBProject.VBComponents("Feuil1").CodeModule.AddFromString _
    ("Private Sub Worksheet_Change(ByVal Target As Range)" & vbCrLf & _
    "MsgBox ""Coucou""" & vbCrLf & "End Sub")
End Sub

Attention, il faut avoir coché dans le gestionnaire de confidentialité -> Paramètres des macros -> Accès approuvé au modèle d'objet du projet VBA.
Bon courage 😎

 

[YANN-56]

Re : Copier un code dans ThisWorkbook

Bonjour créolia et à tous,

Il y aurait peut-être une solution en ayant une Feuille "Matrice"
dans un autre Classeur servant de base de données.
Celle-ci ayant la Macro requise (Voir les contrôles)

Il suffirait de l'ajouter au Classeur maître. (En la rebaptisant au besoin)

Mais cela ne sera effectivement valable que pour les feuilles nouvellement crées;
mais pour les existantes... Je ne sais pas faire!

Amicalement.

Yann

 

[Pierrot93]

Re : Copier un code dans ThisWorkbook

Bonjour à tous

tu peux aussi placer ton code dans le module "thisworkbook" en utilisant les événements concernant les feuilles, ce code sera actif sur toutes les feuilles du classeur en question, même les feuilles que tu créeras par la suite...

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
'ton code
End Sub

bon après midi
@+

 

[YANN-56]

Re : Copier un code dans ThisWorkbook

Bonjour JNP,

Je viens de voir un mot dans ton code qui me fait faire "Tilt"

"ThisWorkbook.VBProject"

N'aurais-tu pas une idée par ce biais pour le souci que j'ai exposé ici:
https://www.excel-downloads.com/thr...ui-ont-ete-ouverts-dans-un-webbrowser.148872/

Car semble-t-il c'est de ce coté qu'il faudrait savoir agir, comme je soupçonne
que tu saches le faire, au regard de l'aide que tu viens d'apporter à creolia.

Pardon d'avoir dévié, mais mon désespoir d'être toujours coincé m'y pousse. 😡

Amicalement.

Yann

 

[JNP]

Re : Copier un code dans ThisWorkbook

Re 🙂,

N'aurais-tu pas une idée par ce biais pour le souci que j'ai exposé ici:
https://www.excel-downloads.com/thr...ui-ont-ete-ouverts-dans-un-webbrowser.148872/

Je ne pense pas que cela soit la bonne solution...
C'est plutôt une sorte de rémanence, qui tant que Excel n'est pas totalement fermé, laisse les projets VBA ouverts (ceci depuis 2007 si je ne m'abuse). Personnellement, je dirais que le mieux est de fermer totalement l'application avec

Workbooks.Close

Sinon, tu peux tester

Sub Test()
Dim I As Integer
For I = 1 To Workbooks("Classeur4").VBProject.VBComponents.Count
MsgBox Workbooks("Classeur4").VBProject.VBComponents(I).Name
Next I
End Sub

et une fois ton index déterminé

Sub Test2()
Application.VBE.ActiveVBProject.VBComponents.Remove Workbooks("Classeur4").VBProject.VBComponents(5)
End Sub

mais fait une sauvegarde de ton fichier avant, on ne sait jamais 😛...
Bon courage 😎

 

[YANN-56]

Re : Copier un code dans ThisWorkbook

Merci pour ta réponse JNP,

Et mes excuses à tous d'avoir envahi ce Fil avec une question qui n'avait rien à y faire.

Aujourd'hui, mon ordre de fermeture des VBBProjects fonctionne,
mais à condition d'avoir unloadé l'USF concerné et de mettre ce code
dans un autre USF. (Cela est cependant gênant dans ma structure)

Je vais tenter tes idées.

Sympa de ta part! Je te tiens au courant en MP.

Amicalement

Yann

 

[creolia]

Re : Copier un code dans ThisWorkbook

Bonjour à tous désolé de répondre aussi tard petite panne informatique

je vous remercie d'avoir répondu à ma question j'ai opter pour la solution de JPN

mais petit soucis

le code que je veut integrer à la macro est

Private Sub Worksheet_Change(ByVal Target As Range) 
If Application.Intersect(Target, Range("E5:E65536")) Is Nothing Then Exit Sub
If Selection.Cells.Count > 1 Then Exit Sub 
If Target.Value = "" Then Exit Sub  
Sheets("FORMATION52").Range(Target.Address).Value = "" MsgBox "La Formation initiale à été réinitialisé"
End Sub

le probleme c'est que je doit mal le mettre car les lignes se mette en rouge

pouvez vous m'expliquer ou le mettre exactement svp merci

 

[Pierrot93]

Re : Copier un code dans ThisWorkbook

Bonjour à tous,

cette ligne doit être scindée en 2 :

Sheets("FORMATION52").Range(Target.Address).Value = "" MsgBox "La Formation initiale à été réinitialisé"
End Sub

comme ceci :

Sheets("FORMATION52").Range(Target.Address).Value = "" 
MsgBox "La Formation initiale à été réinitialisé"
End Sub

bonne journée
@+

 

[creolia]

Re : Copier un code dans ThisWorkbook

Re merci j'ai essayer donc comme ceci

Sub recycle()
ThisWorkbook.VBProject.VBComponents("Feuil1").CodeModule.AddFromString _
    ("Private Sub Worksheet_Change(ByVal Target As Range)" & vbCrLf & _
    "If Application.Intersect(Target, Range("E5:E65536")) Is Nothing Then Exit Sub
If Selection.Cells.Count > 1 Then Exit Sub 'si il plus d'une d'une seule cellule sélectionnée, sort de la procédure
If Target.Value = "" Then Exit Sub 'si la cellule est éffacée, sort de la procédure
 
Sheets("FORMATION52").Range(Target.Address).Value = "" 'efface la cellule correspondante de l'onglet "FORMATION52"
MsgBox "La Formation initiale à été réinitialisé"" & vbCrLf & "End Sub")


End Sub

si j'ai bien compris mais sa marche toujour pas une partis du code est en rouge

 

[Pierrot93]

Re : Copier un code dans ThisWorkbook

Re,

c'est un autre code que celui que tu donnais à 10h59.....

 

[creolia]

Re : Copier un code dans ThisWorkbook

Non c'est le même mais cette fois je l'ai mis dans le module que JNP m'avais proposer plus haut c'est a dire celui ci

Sub Test()
ThisWorkbook.VBProject.VBComponents("Feuil1").CodeModule.AddFromString _
    ("Private Sub Worksheet_Change(ByVal Target As Range)" & vbCrLf & _
    "MsgBox ""Coucou""" & vbCrLf & "End Sub")
End Sub

mon code que je veut inserer dedans est celui ci

Private Sub Worksheet_Change(ByVal Target As Range) 
If Application.Intersect(Target, Range("E5:E65536")) Is Nothing Then Exit Sub
If Selection.Cells.Count > 1 Then Exit Sub 
If Target.Value = "" Then Exit Sub  
Sheets("FORMATION52").Range(Target.Address).Value = "" MsgBox "La Formation initiale à été réinitialisé"
End Sub

ce qui à donnée ceci

Sub recycle()
ThisWorkbook.VBProject.VBComponents("Feuil1").CodeModule.AddFromString _
    ("Private Sub Worksheet_Change(ByVal Target As Range)" & vbCrLf & _
    "If Application.Intersect(Target, Range("E5:E65536")) Is Nothing Then Exit Sub
If Selection.Cells.Count > 1 Then Exit Sub 'si il plus d'une d'une seule cellule sélectionnée, sort de la procédure
If Target.Value = "" Then Exit Sub 'si la cellule est éffacée, sort de la procédure
 
Sheets("FORMATION52").Range(Target.Address).Value = "" 'efface la cellule correspondante de l'onglet "FORMATION52"
MsgBox "La Formation initiale à été réinitialisé"" & vbCrLf & "End Sub")


End Sub

malheureusement ne marche pas

 

[JNP]

Re : Copier un code dans ThisWorkbook

Re 🙂,
Vu comme ceci, ça ira mieux 😛...

[COLOR=blue]Sub[/COLOR] recycle()
ThisWorkbook.VBProject.VBComponents("Feuil1").CodeModule.AddFromString _
    ("Private Sub Worksheet_Change(ByVal Target As Range)" & vbCrLf & _
    "If Application.Intersect(Target, Range(""E5:E65536"")) Is Nothing Then Exit Sub" & vbCrLf & _
    "If Selection.Cells.Count > 1 Then Exit Sub 'si il plus d'une d'une seule cellule sélectionnée, sort de la procédure" & vbCrLf & _
    "If Target.Value = """" Then Exit Sub 'si la cellule est éffacée, sort de la procédure" & vbCrLf & _
    "Sheets(""FORMATION52"").Range(Target.Address).Value = """" 'efface la cellule correspondante de l'onglet FORMATION52" & vbCrLf & _
    "MsgBox ""La Formation initiale à été réinitialisé""" & vbCrLf & "End Sub")
[COLOR=blue]End Sub[/COLOR]

Tu dois doubler les " quand il faut qu'elles restent dans la string, et tu doit entrecouper chaque ligne par des vbcrlf pour aller à la ligne 😉.
Bon courage 😎