copie de code

[Yvanoe]

bonsoir,

j'ai une macro qui me copie plusieurs onglets, je cherche à savoir s'il est possible d'inserer automatiquement du code et un bouton de commande dans chaque nouveau onglet

d'avnace merci à tous

yvanoé

 

[Zon]

Salut,

Cela ressemble à ce que demander Emeric, il faudra que je le mette sur mon wiki.
Voici un exemple de code où le nom du bouton est "Bouton1" et pour caption "Mon Bouton" .


Sub Princ() 'Zon
Dim Ch$, F As Worksheet
Set F = Sheets(1) 'à adapter
SupprObj F, "Bouton1"
SupprUneProc ThisWorkbook, F.CodeName, "Bouton1_Click"
Ch = "MsgBox ""Salut XLD"""
AjouterUnObj Sheets(1), "Forms.commandbutton.1", Array("Bouton1", 30, 4, 100, 20, "Mon Bouton")
AjouterProcEven ThisWorkbook, F.CodeName, "Click", "Bouton1", Ch
End Sub

Sub AjouterUnObj(F As Worksheet, Objet$, Optional T)
Dim B As OLEObject
Set B = F.OLEObjects.Add(Objet)
If IsMissing(T) Then Exit Sub
With B
.Name = T(0)
.Left = T(1)
.Top = T(2)
.Width = T(3)
.Height = T(4)
.Object.Caption = T(5)
End With
End Sub

Sub AjouterProcEven(C As Workbook, NomModule$, Evenement$, Objet$, Code$)
With C.VBProject.VBComponents(NomModule).CodeModule
.InsertLines .CreateEventProc(Evenement, Objet) + 1, Code
End With
End Sub

Sub SupprUneProc(C As Workbook, NomModule$, NomProc$)
On Error Resume Next
With C.VBProject.VBComponents(NomModule).CodeModule
.DeleteLines .ProcStartLine(NomProc, 0), .ProcCountLines(NomProc, 0)
End With
End Sub

Sub SupprObj(F As Worksheet, Nom$)
On Error Resume Next
F.OLEObjects(Nom).Delete
End Sub


A+++

 

[Yvanoe]

Bonjour Zon,

merci de ta réponse, cependant je suis novice en VBA, pourrais tu simplement m'indiquer les différentes étapes de ta macro afin que je puisse l'adapter à mon tableur.

d'autre part, j'utilise dans ma macro ce qui suis,

Set Sht = Worksheets.Add(After:=Worksheets(Worksheets.Count))
Sht.Name = "EDT." & Emp

Emp représente une liste d'employés et EDT leur Emploi du Temps
Comment puis je adapter ta macro pour chacune des feuilles crées.

d'avance merci pour ces éclaircissements.

A+

Yvanoé

 

[Robert]

Salut Yvanoe, salut Zon,

Hier soir j'ai piqué ma crise sur ce cas. J'avais gardé précieusement un demo de l'incontournable Zon qui faisait la même chose mais non pas sur des feuilles mais sur un nouveau classeur. Je me suis dit : "Tu vas l'adapter et l'envoyer à Yvanoe..." Que dalle ! Je n'ai reussi à le faire que pour une seule feuille. Impossible de faire une boucle car cela provoquait carrément la fermeture d'Excel. J'espérais alors que Zon ferait un tour sur ce fil mais je n'ai pas eu le courage d'attendre si tard... Et voili, voilà, le Maître a viendu, a vu et a vaincu... Dès que j'en aurais le temps je vais analyser tout ça et essayer de comprendre mon échec. Tout mon blabla inintéressant juste pour dire un grand merci à Môssieu Zon.

À plus,

Robert

 

[Zon]

Salut,


Set F = Sheets(1) 'r et
Set Sht = Worksheets.Add(After:=Worksheets(Worksheets.Count)) c'est la même chose.
supprobj et suppruneproc sont inutiles, Sht étant vierge de code puisqu'elle vient d'ëtre créée.

Ch = "MsgBox ""Salut XLD""" 'ici c'est le code qu'on va mettre
AjouterUnObj Sht, "Forms.commandbutton.1", Array("Bouton1", 30, 4, 100, 20, "Mon Bouton") 'on ajoute le bouton
AjouterProcEven ThisWorkbook, sht.CodeName, "Click", "Bouton1",Ch 'on associe le code au bouton.

EN conclusion, tu as juste à dapter Ch et le tableau Array("..." pour le nom du bouton et sa position.

A+++