>>> DATABASE XLD <<< FIL RECENCEMENT FIL >> 21649 "VBA Effacement Macro"
Bonjour au gens de ce Fil
numéro 21649
Comme c'est une de mes périodes d'absences du forum je regardes les fils de début Mars... Et je viens de tomber sur celui là... En cherchant quelque chose pour Jane dans le fil
27459 où il veut Fermer complètement VBE ... je cherche, je cherche... Mais comme j'ai lu ici, je m'incruste !! (hihihi)
Juste pour remercie Crazygil du commentaire di-dessus... et juste por référencement correct, je te révise un poil car ton copier/collé est un peu manqué.
===================
Destruction d'une macro contenue dans le Private Module de Sheet :
Sub KillPrivateSubSheet()
With ActiveWorkbook.VBProject.VBComponents(ActiveWorkbook.Sheets("Feuil1").CodeName).CodeModule
.DeleteLines 1, .CountOfLines
.CodePane.Window.Close
End With
End Sub
Cette macro détruit toutes les lignes du Private Module deSheet, puis ferme le module en question pour faire plus propre.
===================
Destruction d'une macro contenue dans le Private Module ThisWorkBook :
Sub Supprime_ThisWorkBookMacro()
With ActiveWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule
.deleteLines 1, .CountOfLines
.CodePane.Window.Close
End With
End Sub
===================
Destruction Sélective d'une macro évènementielle dans ThisWorbook (2 exemples) :
Sub supprimer_evenementielle1()
Dim vbext_pk_Proc As Long
Dim debut As Integer
Dim nblignes As Integer
With ActiveWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule
debut = .ProcStartLine("Workbook_Open", vbext_pk_Proc)
nblignes = .ProcCountLines("Workbook_Open", vbext_pk_Proc)
.deleteLines debut, nblignes
End With
End Sub
ou encore :
Sub supprimer_evenementielle2()
Dim vbext_pk_Proc As Long
Dim debut As Integer
Dim nblignes As Integer
With ActiveWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule
debut = .ProcStartLine("Workbook_BeforeClose", vbext_pk_Proc)
nblignes = .ProcCountLines("Workbook_BeforeClose", vbext_pk_Proc)
.deleteLines debut, nblignes
End With
End Sub
===================
...Et tant qu'on est dans les écritures sur modules je fais un rappel on peut aussi écrire aprés avoir tou détruit (lol) !
Ecrire une évènementielle dans le module "ThisWorkBook" d'un autre classeur (2 exemples):
Pour cet exemple l'autre classeur se nomme donc "New"
Sub EcrireThisWorkBook1()
Dim X As Integer
With Workbooks("New.xls").VBProject.VBComponents("ThisWorkbook").CodeModule
X = .CountOfLines
.InsertLines X + 1, "Private Sub Workbook_Open()"
.InsertLines X + 2, "MsgBox ""Coucou"",VBinformation "
.InsertLines X + 3, "End Sub"
End With
End Sub
ou encore :
Sub EcrireThisWorBook2()
Dim VBA As String
VBA = VBA & "Private Sub Workbook_Open()" & vbCrLf
VBA = VBA & "MsgBox ""Coucou"",VBinformation " & vbCrLf
VBA = VBA & "End Sub" & vbCrLf
With Workbooks("New.xls").VBProject.VBComponents("ThisWorkbook").CodeModule
.AddFromString VBA
End With
End Sub
===================
Copie d'une macro contenue dans un Module Standard d'un classeur source pour être ré-écrite vers un classeur Cible :
>>>Code du Grand Frédérique Singonneau <<<
Sub CopieCodeModule()
Dim S As String, Wbk As Workbook
With ActiveWorkbook.VBProject.VBComponents("Module1").CodeModule
S = .Lines(1, .CountOfLines)
End With
Set Wbk = Workbooks("New.xls")
Wbk.VBProject.VBComponents.Add 1
With Wbk.VBProject.VBComponents("Module1").CodeModule
.AddFromString S
End With
End Sub
===================
...Et puis ne pas oublier ceci :
Création à la volé d'un bouton dans un UserForm :
Private Sub UserForm_Initialize()
Dim NewControl As CommandButton
Set NewControl = UserForm1.Controls.Add("Forms.CommandButton.1", "CommandButton1")
With NewControl
.Left = 80
.Top = 60
.Caption = "OKIIII"
End With
End Sub
Par contre voici comment écrire le code dans le module....
Sub MacroCommandButton1()
Dim x As Integer
With ThisWorkbook.VBProject.VBComponents("UserForm1").CodeModule
x = .CountOfLines
.InsertLines x + 1, "Sub CommandButton1_Click()"
.InsertLines x + 2, "MsgBox ""Bye Bye"",VBinformation "
.InsertLines x + 3, " Unload Me"
.InsertLines x + 4, "End Sub"
End With
End Sub
Mais ne me demandez pas de joindre les deux.... Je n'ai pas encore capté, enfin c'est just for the fun si çà peut donner des idées...
===================
Voilà comme çà ce fil N° 21649 devient très utile
Sur ce bonne soirée à tous et toutes !
@+Thierry
