Afficher un message
Vieux 21/04/2003, 20h47   #8 (permalink)
@+Thierry
Guest
 
Messages: n/a
Par défaut >>> 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(ActiveWorkbo ok.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("ThisWorkboo k").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("ThisWorkboo k").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("ThisWorkboo k").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("ThisW orkbook").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("ThisW orkbook").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").C odeModule
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").C odeModule
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