Bonjour à tous... j ai une dernière petite question...
J ouvre un fichier et une macro s exécute automatiquement... les procédures se déroulent sans problèmes et le fichier se sauvegarde sous un nom bien défini.
Mais mon problème est que lors d une prochaine ouverture du fichier sauvegardé, la macro s exécute à nouveau alors que justement elle ne devrait plus.
Y a t il moyen d effacer le contenu de la macro sous VB, je veux dire par là, effacer les procèdures à accomplir???

Un grand merci à quiconque pourra me répondre.

Thibaut

Bonjour Thibaut

C'est possible, j'utilise ce code moi même, si mes souvenir sont bon, c'est un truc que @Thierry a donner sur le forum

Tu dois bien tenir compte de quelque petit chose, tu dois dans ton code supprimer les macro du doc excel, ensuite sauvegardé sous, et ensuite fermé les deux document sans sauvé le doc d'origine, parce que aussi non tu enregistre avec tes macro supprimer, essaye de t'en sortir.

Voila le code qui supprime les macro de la feuille1

With ActiveWorkbook.VBProject.VBComponents(ActiveWorkbo ok.Sheets("Feuil1").CodeName).CodeModule
.DeleteLines 1, .CountOfLines
.CodePane.Window.Close
End With


Pour supprimer tous, Code VBA, Userform, Module,... ca moi je bosse autrement, je copie la feuil dans un nouveau doc avec le code suivant:

Sheets("Feuil1").Select
Sheets("Feuil1").Copy

Ensuite je sauf mon nouveau doc sous et je ferme le tous, le nouveau doc est complétement vide de tous VBA


A toi de voir

@Christophe@

euh... bon... j ai bien compris le truc mais ça ne va pas trop... mais c est bien gentil à toi quand même, merci... Je vais encore essayer... j ai surement fait qqchose de travers p
Bonne journée

Thibaut

Re

Si tu ne t'en sors pas, mail moi je fichier, je te regarde cela

@Christophe@

Trouvé... p ... un bête petit oubli de changement de références... merci @Christophe@ ... et bonne journée

Re

Ok, Super Thibaut

Bonne journée a toi aussi

@Christophe@

Salut à tous,

Voici une réponse en VBA qui m'a été donné par un Des Maitres XLD: @+Thierry

Sub KillPrivateSubSheet ()
With ActiveWorkbook.VBProject.VBComponents (ActiveWorkbook.Sheets("Feuil1").CodeName) .CodeModule.Deletelines 1, .CountOfLines.CodePane.Window.Close
End With
End Sub

Si je ne me suis pas planté dans la retranscription et que cela marche tu peux remercier @+Thierry; sinon j'ai le droit de réverifier ma transcription.
A plus.

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

Bonjour à tout le monde !

Comme Ti a donné la solution pour fermer VBE dans le , je mets le lien ici !

Fil Numero 27459

Bonne Journée
@+Thierry

Et puis si vous voulez jouez les Atilas

DESTRUCTION (plus aucun module ne pusse après cà !!!!)

Sub EffaceMacro ()
Dim VBC As Object

With ActiveWorkbook.VBProject
For Each VBC In .VBComponents
If VBC.Type = 100 Then
With VBC.CodeModule
.DeleteLines 1, .CountOfLines
.CodePane.Window.Close
End With
Else: .VBComponents.Remove VBC
End If
Next VBC
End With
End Sub

Signé Atila@Christophe@ !!!

... çà peut ptet servir un jour ... MAIS DANGER !!!

Voilà !! ça complète le fil

@+Thierry

Bonsoir à tous,

J'ai beau essayer mais je n'y parviens pas. Il me faut remplacer "News.xls"

dans << Set Wbk = Workbooks("New.xls") >>

du post 21649 "VBA Effacement Macro"

pour y placer une variable "nomfichier" qui contiendra le nom du fichier "S10B.xls".

Merci.

Bonjour CactusX, le Forum (enfin si quelqu'un passe par un si ancien fil!)

A mon avis ton problème vient du fait que tu tentes de faire tourner ce code avant que le classeur soit sauvé sous son nom "S10B.xls"... alors même si la variable "nomfichier" est initialisé, le Set de Workbook ne peut fonctionner que sur un classeur ouvert existant....

Il faut toujours rester très logique dans l'ordre des évènements en programmation... Et c'est ce qui doit t'échapper.

Bon Appétit
@+Thierry

Bonsoir le Forum, Thierry,

Effectivement de nombreuses choses m'échappent. Mais tes explications et exemples sont toujours limpides.

Merci à toi.

A+

Bonjour les Forumeurs...

Tiens je repasse par ce fil pour complément d'info....En ce qui concerne l'écriture d'une macro pour la création d'un UserForm à la Volée...

Dans mon post ci dessus du 21-04-03 20:47, je disais :"Mais ne me demandez pas de joindre les deux.... Je n'ai pas encore capté" en ce qui concernait la crétion de UserForm à la Volée...

Donc depuis j'ai eu à travailler la dessus et donc voici comment faire une Message Box par UserForm créé à la Volée puis détruit à la Sortie... :

Option Explicit
Dim USF As Object

Sub Message()
Dim Lab1 As Object, CmdB As Object
Dim X As Byte
Dim LaValeur As String
LaValeur = InputBox("Taper un Text !!", "Thierry's Démo", "Voici un Text")

Set USF = ThisWorkbook.VBProject.VBComponents.Add(3)
With USF
.Properties("Caption") = "Thierry's Démo"
.Properties("Width") = 150
.Properties("Height") = 80
End With

With USF.CodeModule
X = .CountOfLines
.insertlines X + 1, "'Thierry's Démo"
.insertlines X + 2, ""
.insertlines X + 3, "Sub CommandButton1_Click()"
.insertlines X + 4, " Unload Me"
.insertlines X + 5, " KillMe"
.insertlines X + 6, "End Sub"
.insertlines X + 7, ""
.insertlines X + 8, "Private Sub UserForm_QueryClose (Cancel As Integer, CloseMode As Integer)"
.insertlines X + 9, " KillMe"
.insertlines X + 10, "End Sub"
.insertlines X + 11, "'Sacré Boulot pour être détruit comme çà aussi sec ! lol @+Thierry !!!"
End With

Set Lab1 = USF.Designer.Controls.Add("Forms.Label.1")
With Lab1
.Caption = LaValeur
.Left = 10: .Top = 12: .Width = 145: .Height = 12
End With

Set CmdB = USF.Designer.Controls.Add("Forms.CommandButton.1")
With CmdB
.Caption = "OK"
.Left = 60: .Top = 30: .Width = 60: .Height = 18
End With
VBA.UserForms.Add(USF.Name).Show

Set USF = Nothing
Set Lab1 = Nothing
Set CmdB = Nothing
End Sub

Sub KillMe()
ThisWorkbook.VBProject.VBComponents.Remove USF
End Sub



Pour en savoir plus... Démos sur ce Sujet en ligne :

Fausse Message Box à la Position du Right Click
=> Fichier USF_Message_Position_du_RightClick.V01.zip (32k)

=> Fil de Discussion => DEMO UserForm éphémère (bis) avec GetCursorPos pour la position d'une MsgBox



[/i]UseForm de Recherche de String avec ListBox[/i]
=> Fichier USF_ListBox_A_La_Volee.zip (48k)

=> Fil de Discussion => DEMO Userform ListBox éphémère / Créé de toute pièce à la Volée en VBA !!


Comme ceci ce fil de discussion est bouclé !! (lol)

Bon Week End
@+Thierry

Rebonjour ceFil et le Forum


Tiens et puis il y avait Stef et Florian qui parlaient d'un problème pour effacer des macros évènementielles de Private Module de Feuille dans un nouveau classeur sauvé à partir d'une feuille copié d'un classeur Maitre (Fil de discussion

Donc en plus de la Macro si dessus : "Destruction d'une macro contenue dans le Private Module de Sheet " j'ai pensé qu'il y avait une lacune dans ce fil pour ce cas de figure :

Voici comme faire pour détruire sélectivement une macro évènementielle contenue dans le private Module d'une feuille d'un autre classeur.

Destruction Sélective d'une Macro Evènementielles dans un Private Module de Feuille

Pour l'exemple le classeur distant se nomme "Facture.xls" et la l'onglet de Feuille en question se nomme "Facture"

Sub DeleteSubOtherWorkBookPrivateSheet()
Dim WB As Workbook
Dim Code As Object
Dim NomProc As String, NomFeuille As String
Dim DebCode As Integer, LongCode As Integer, VBext_Pk_Proc As Long

On Error GoTo FirstError
Set WB = Workbooks("Facture.xls")
NomProc = "Worksheet_SelectionChange"
NomFeuille = "Facture"

On Error GoTo SecondError
Set Code = WB.VBProject.VBComponents(WB.Sheets(NomFeuille).Co deName).CodeModule

DebCode = Code.ProcStartLine(NomProc, VBext_Pk_Proc)
LongCode = Code.ProcCountLines(NomProc, VBext_Pk_Proc)
Code.DeleteLines DebCode, LongCode
Exit Sub
FirstError:
If Err = 9 Then MsgBox "Classeur recherché pas ouvert"
Exit Sub
SecondError:
If Err = 9 Then MsgBox NomFeuille & " Private Module de Feuille non trouvé"
If Err = 35 Then MsgBox NomProc & " Macro pas trouvée"
End Sub

J'y ai ajouté un gestionnaire d'erraur au cas où, (c'est facile de planter quand on fait des trucs comme ceci... (lol)

Puis dans la Foulé :

Destruction Sélective d'une Macro Evènementielles dans le Private Module ThisWorkBook

Sub DeleteSubOtherWorkBook()
Dim WB As Workbook
Dim Code As Object
Dim NomProc As String, NomModule As String
Dim DebCode As Integer, LongCode As Integer, VBext_Pk_Proc As Long

On Error GoTo FirstError
Set WB = Workbooks("Facture.xls")
NomProc = "Workbook_BeforeClose"
NomModule = "ThisWorkBook"

On Error GoTo SecondError
Set Code = WB.VBProject.VBComponents(NomModule).CodeModule
DebCode = Code.ProcStartLine(NomProc, VBext_Pk_Proc)
LongCode = Code.ProcCountLines(NomProc, VBext_Pk_Proc)
Code.DeleteLines DebCode, LongCode
Exit Sub
FirstError:
If Err = 9 Then MsgBox "Classeur recherché pas ouvert"
Exit Sub
SecondError:
If Err = 9 Then MsgBox NomModule & " Module non trouvé"
If Err = 35 Then MsgBox NomProc & " Macro pas trouvée"
End Sub

A Noter que cette dernière macro sera la même pour détruire sélectivement une macro "normale" dans un module standard... Juste changer :
NomProc = "MaMacro"
NomModule = "ModuleX"

Voilà là je crois qu'on a fait le tour !!! lol

Bonne fin de Week End à tous et toutes
@+Thierry