Effacer code fichier en cours

Le
JulieH
Bonjour,

Je cherche à effacer tout le code du fichier en cours. Pour cela,
j'utilise le code suivant :

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
ActiveWorkbook.Save


Tout fonctionne bien car après avoir lancer la macro, j'ai bien le
résultat escompté.

Cependant, lorsque je ferme le fichier, sans n'avoir fait aucune autre
manip, il me demande si je veux enregistrer :
- Si je réponds "oui", pas de problème le fichier n'a plus de code.
- Si je réponds "non", le code réapparaît. Il n'a pas pris en compte le
"save", ce qui semble assez logique étant donné que la macro elle-même
n'existe plus.

Ce que je souhaite : effacer le code, enregistrer immédiatement le
fichier pour que le code disparaissent définitivement, garder le fichier
ouvert (si possible).

Merci de vos idées.

Julie
Vidéos High-Tech et Jeu Vidéo
Téléchargements
Vos réponses
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
tissot.emmanuel
Le #4909691
Bonjour,

Les procédures suivantes doivent prendre place dans le même module (ici
nommé Module1) du classeur qui doit se saborder.

Bonne chance,

Manu/

Sub MacroSuicide()
Dim NomFichierModule As String
Application.ScreenUpdating = False
'Ajoute un classeur temporaire
Workbooks.Add
'Exporte ce module
With ThisWorkbook
NomFichierModule = .Path & "Module1.bas"
.VBProject.VBComponents("Module1").Export NomFichierModule
End With
'Copie ce module dans le classeur temporaire
ActiveWorkbook.VBProject.VBComponents.Import NomFichierModule
'Supprime le fichier module temporaire
Kill NomFichierModule
'Programme la procedure de suppression
Application.Run ActiveWorkbook.Name & "!" & "Attendre",
Left(ThisWorkbook.Name, Len(ThisWorkbook.Name) - 4)
'Termine le programme exécuté par ce classeur
End
End Sub

Sub Attendre(NomClasseur As String)
Application.OnTime Now + TimeValue("00:00:01"), "'SupprimerMacros """ &
NomClasseur & """'"
End Sub

Sub SupprimerMacros(NomClasseur As String)
Dim VBC As Object
Application.ScreenUpdating = False
With Workbooks(NomClasseur).VBProject 'supprime les macros
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
Workbooks(NomClasseur).Save 'enregistre le classeur
ThisWorkbook.Close False 'ferme classeur temporaire
End Sub


"JulieH"
Bonjour,

Je cherche à effacer tout le code du fichier en cours. Pour cela,
j'utilise le code suivant :

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
ActiveWorkbook.Save


Tout fonctionne bien car après avoir lancer la macro, j'ai bien le
résultat escompté.

Cependant, lorsque je ferme le fichier, sans n'avoir fait aucune autre
manip, il me demande si je veux enregistrer :
- Si je réponds "oui", pas de problème le fichier n'a plus de code.
- Si je réponds "non", le code réapparaît. Il n'a pas pris en compte le
"save", ce qui semble assez logique étant donné que la macro elle-même
n'existe plus.

Ce que je souhaite : effacer le code, enregistrer immédiatement le
fichier pour que le code disparaissent définitivement, garder le fichier
ouvert (si possible).

Merci de vos idées.

Julie


JulieH
Le #4599891
Bonjour et merci pour ta réponse,

Je vais essayé cela dans la journée.

Julie

Bonjour,

Les procédures suivantes doivent prendre place dans le même module (ici
nommé Module1) du classeur qui doit se saborder.

Bonne chance,

Manu/

Sub MacroSuicide()
Dim NomFichierModule As String
Application.ScreenUpdating = False
'Ajoute un classeur temporaire
Workbooks.Add
'Exporte ce module
With ThisWorkbook
NomFichierModule = .Path & "Module1.bas"
.VBProject.VBComponents("Module1").Export NomFichierModule
End With
'Copie ce module dans le classeur temporaire
ActiveWorkbook.VBProject.VBComponents.Import NomFichierModule
'Supprime le fichier module temporaire
Kill NomFichierModule
'Programme la procedure de suppression
Application.Run ActiveWorkbook.Name & "!" & "Attendre",
Left(ThisWorkbook.Name, Len(ThisWorkbook.Name) - 4)
'Termine le programme exécuté par ce classeur
End
End Sub

Sub Attendre(NomClasseur As String)
Application.OnTime Now + TimeValue("00:00:01"), "'SupprimerMacros """ &
NomClasseur & """'"
End Sub

Sub SupprimerMacros(NomClasseur As String)
Dim VBC As Object
Application.ScreenUpdating = False
With Workbooks(NomClasseur).VBProject 'supprime les macros
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
Workbooks(NomClasseur).Save 'enregistre le classeur
ThisWorkbook.Close False 'ferme classeur temporaire
End Sub


"JulieH"
Bonjour,

Je cherche à effacer tout le code du fichier en cours. Pour cela,
j'utilise le code suivant :

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
ActiveWorkbook.Save


Tout fonctionne bien car après avoir lancer la macro, j'ai bien le
résultat escompté.

Cependant, lorsque je ferme le fichier, sans n'avoir fait aucune autre
manip, il me demande si je veux enregistrer :
- Si je réponds "oui", pas de problème le fichier n'a plus de code.
- Si je réponds "non", le code réapparaît. Il n'a pas pris en compte le
"save", ce qui semble assez logique étant donné que la macro elle-même
n'existe plus.

Ce que je souhaite : effacer le code, enregistrer immédiatement le
fichier pour que le code disparaissent définitivement, garder le fichier
ouvert (si possible).

Merci de vos idées.

Julie






JulieH
Le #4599851
Après essai, cela ne fonctionne pas complètement.

J'ai une erreur d'execution 9 "L'indice n'appartient pas à la sélection"
et la Macro bloque sur la ligne suivante :
With Workbooks(NomClasseur).VBProject 'supprime les macros
J'ai changé NomClasseur pour le nom du fichier en cours. Sans succès.

Merci pour vos idées.

Julie


Bonjour,

Les procédures suivantes doivent prendre place dans le même module (ici
nommé Module1) du classeur qui doit se saborder.

Bonne chance,

Manu/

Sub MacroSuicide()
Dim NomFichierModule As String
Application.ScreenUpdating = False
'Ajoute un classeur temporaire
Workbooks.Add
'Exporte ce module
With ThisWorkbook
NomFichierModule = .Path & "Module1.bas"
.VBProject.VBComponents("Module1").Export NomFichierModule
End With
'Copie ce module dans le classeur temporaire
ActiveWorkbook.VBProject.VBComponents.Import NomFichierModule
'Supprime le fichier module temporaire
Kill NomFichierModule
'Programme la procedure de suppression
Application.Run ActiveWorkbook.Name & "!" & "Attendre",
Left(ThisWorkbook.Name, Len(ThisWorkbook.Name) - 4)
'Termine le programme exécuté par ce classeur
End
End Sub

Sub Attendre(NomClasseur As String)
Application.OnTime Now + TimeValue("00:00:01"), "'SupprimerMacros """ &
NomClasseur & """'"
End Sub

Sub SupprimerMacros(NomClasseur As String)
Dim VBC As Object
Application.ScreenUpdating = False
With Workbooks(NomClasseur).VBProject 'supprime les macros
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
Workbooks(NomClasseur).Save 'enregistre le classeur
ThisWorkbook.Close False 'ferme classeur temporaire
End Sub


"JulieH"
Bonjour,

Je cherche à effacer tout le code du fichier en cours. Pour cela,
j'utilise le code suivant :

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
ActiveWorkbook.Save


Tout fonctionne bien car après avoir lancer la macro, j'ai bien le
résultat escompté.

Cependant, lorsque je ferme le fichier, sans n'avoir fait aucune autre
manip, il me demande si je veux enregistrer :
- Si je réponds "oui", pas de problème le fichier n'a plus de code.
- Si je réponds "non", le code réapparaît. Il n'a pas pris en compte le
"save", ce qui semble assez logique étant donné que la macro elle-même
n'existe plus.

Ce que je souhaite : effacer le code, enregistrer immédiatement le
fichier pour que le code disparaissent définitivement, garder le fichier
ouvert (si possible).

Merci de vos idées.

Julie






tissot.emmanuel
Le #4599831
Bonjour,

Pour reproduire l'erreur j'ai du exécuter le code dans un nouveau classeur
sans l'avoir jamais enregistré auparavant. Dans ce cas le nom de classeur
passé à la procédure est incorrecte puisque tronqué d'une extension (.xls)
qui n'existe pas par la ligne suivante.

Application.Run ActiveWorkbook.Name & "!" & "Attendre",
Left(ThisWorkbook.Name, Len(ThisWorkbook.Name) - 4)

A la réflexion je me demande bien pourquoi je faisais ca...

Tu peux modifier cette ligne ainsi:

Application.Run ActiveWorkbook.Name & "!" & "Attendre", ThisWorkbook.Name

ou enregistrer ton classeur avant de lancer le test.

Et tant que je suis la, tu peux ajouter:

Application.VBE.MainWindow.Visible = False

au début de la procédure SupprimerMacros pour éviter le clignotement
intempestif de l'écran.

Cordialement,

Manu/


"JulieH"
Après essai, cela ne fonctionne pas complètement.

J'ai une erreur d'execution 9 "L'indice n'appartient pas à la sélection"
et la Macro bloque sur la ligne suivante :
With Workbooks(NomClasseur).VBProject 'supprime les macros
J'ai changé NomClasseur pour le nom du fichier en cours. Sans succès.

Merci pour vos idées.

Julie


Bonjour,

Les procédures suivantes doivent prendre place dans le même module (ici
nommé Module1) du classeur qui doit se saborder.

Bonne chance,

Manu/

Sub MacroSuicide()
Dim NomFichierModule As String
Application.ScreenUpdating = False
'Ajoute un classeur temporaire
Workbooks.Add
'Exporte ce module
With ThisWorkbook
NomFichierModule = .Path & "Module1.bas"
.VBProject.VBComponents("Module1").Export NomFichierModule
End With
'Copie ce module dans le classeur temporaire
ActiveWorkbook.VBProject.VBComponents.Import NomFichierModule
'Supprime le fichier module temporaire
Kill NomFichierModule
'Programme la procedure de suppression
Application.Run ActiveWorkbook.Name & "!" & "Attendre",
Left(ThisWorkbook.Name, Len(ThisWorkbook.Name) - 4)
'Termine le programme exécuté par ce classeur
End
End Sub

Sub Attendre(NomClasseur As String)
Application.OnTime Now + TimeValue("00:00:01"), "'SupprimerMacros """
& NomClasseur & """'"
End Sub

Sub SupprimerMacros(NomClasseur As String)
Dim VBC As Object
Application.ScreenUpdating = False
With Workbooks(NomClasseur).VBProject 'supprime les macros
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
Workbooks(NomClasseur).Save 'enregistre le classeur
ThisWorkbook.Close False 'ferme classeur temporaire
End Sub


"JulieH"
Bonjour,

Je cherche à effacer tout le code du fichier en cours. Pour cela,
j'utilise le code suivant :

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
ActiveWorkbook.Save


Tout fonctionne bien car après avoir lancer la macro, j'ai bien le
résultat escompté.

Cependant, lorsque je ferme le fichier, sans n'avoir fait aucune autre
manip, il me demande si je veux enregistrer :
- Si je réponds "oui", pas de problème le fichier n'a plus de code.
- Si je réponds "non", le code réapparaît. Il n'a pas pris en compte le
"save", ce qui semble assez logique étant donné que la macro elle-même
n'existe plus.

Ce que je souhaite : effacer le code, enregistrer immédiatement le
fichier pour que le code disparaissent définitivement, garder le fichier
ouvert (si possible).

Merci de vos idées.

Julie







JulieH
Le #4599341
OK, c'est parfait. Merci pour ton aide.

Julie

Bonjour,

Pour reproduire l'erreur j'ai du exécuter le code dans un nouveau classeur
sans l'avoir jamais enregistré auparavant. Dans ce cas le nom de classeur
passé à la procédure est incorrecte puisque tronqué d'une extension (.xls)
qui n'existe pas par la ligne suivante.

Application.Run ActiveWorkbook.Name & "!" & "Attendre",
Left(ThisWorkbook.Name, Len(ThisWorkbook.Name) - 4)

A la réflexion je me demande bien pourquoi je faisais ca...

Tu peux modifier cette ligne ainsi:

Application.Run ActiveWorkbook.Name & "!" & "Attendre", ThisWorkbook.Name

ou enregistrer ton classeur avant de lancer le test.

Et tant que je suis la, tu peux ajouter:

Application.VBE.MainWindow.Visible = False

au début de la procédure SupprimerMacros pour éviter le clignotement
intempestif de l'écran.

Cordialement,

Manu/


"JulieH"
Après essai, cela ne fonctionne pas complètement.

J'ai une erreur d'execution 9 "L'indice n'appartient pas à la sélection"
et la Macro bloque sur la ligne suivante :
With Workbooks(NomClasseur).VBProject 'supprime les macros
J'ai changé NomClasseur pour le nom du fichier en cours. Sans succès.

Merci pour vos idées.

Julie


Bonjour,

Les procédures suivantes doivent prendre place dans le même module (ici
nommé Module1) du classeur qui doit se saborder.

Bonne chance,

Manu/

Sub MacroSuicide()
Dim NomFichierModule As String
Application.ScreenUpdating = False
'Ajoute un classeur temporaire
Workbooks.Add
'Exporte ce module
With ThisWorkbook
NomFichierModule = .Path & "Module1.bas"
.VBProject.VBComponents("Module1").Export NomFichierModule
End With
'Copie ce module dans le classeur temporaire
ActiveWorkbook.VBProject.VBComponents.Import NomFichierModule
'Supprime le fichier module temporaire
Kill NomFichierModule
'Programme la procedure de suppression
Application.Run ActiveWorkbook.Name & "!" & "Attendre",
Left(ThisWorkbook.Name, Len(ThisWorkbook.Name) - 4)
'Termine le programme exécuté par ce classeur
End
End Sub

Sub Attendre(NomClasseur As String)
Application.OnTime Now + TimeValue("00:00:01"), "'SupprimerMacros """
& NomClasseur & """'"
End Sub

Sub SupprimerMacros(NomClasseur As String)
Dim VBC As Object
Application.ScreenUpdating = False
With Workbooks(NomClasseur).VBProject 'supprime les macros
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
Workbooks(NomClasseur).Save 'enregistre le classeur
ThisWorkbook.Close False 'ferme classeur temporaire
End Sub


"JulieH"
Bonjour,

Je cherche à effacer tout le code du fichier en cours. Pour cela,
j'utilise le code suivant :

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
ActiveWorkbook.Save


Tout fonctionne bien car après avoir lancer la macro, j'ai bien le
résultat escompté.

Cependant, lorsque je ferme le fichier, sans n'avoir fait aucune autre
manip, il me demande si je veux enregistrer :
- Si je réponds "oui", pas de problème le fichier n'a plus de code.
- Si je réponds "non", le code réapparaît. Il n'a pas pris en compte le
"save", ce qui semble assez logique étant donné que la macro elle-même
n'existe plus.

Ce que je souhaite : effacer le code, enregistrer immédiatement le
fichier pour que le code disparaissent définitivement, garder le fichier
ouvert (si possible).

Merci de vos idées.

Julie









Ulysse
Le #4596741
bonjour à toutes et à tous

Je suis intéressé par ton Code Tissot.Emanuel, cependant j'ai une erreur
d'éxécution
L'accès par programme au projet Visual Basic n'est pas fiable
la ligne incriminée est :
.VBProject.VBComponents("Module1").Export NomFichierModule

merci de me débloquer


Bonjour,

Pour reproduire l'erreur j'ai du exécuter le code dans un nouveau classeur
sans l'avoir jamais enregistré auparavant. Dans ce cas le nom de classeur
passé à la procédure est incorrecte puisque tronqué d'une extension (.xls)
qui n'existe pas par la ligne suivante.

Application.Run ActiveWorkbook.Name & "!" & "Attendre",
Left(ThisWorkbook.Name, Len(ThisWorkbook.Name) - 4)

A la réflexion je me demande bien pourquoi je faisais ca...

Tu peux modifier cette ligne ainsi:

Application.Run ActiveWorkbook.Name & "!" & "Attendre", ThisWorkbook.Name

ou enregistrer ton classeur avant de lancer le test.

Et tant que je suis la, tu peux ajouter:

Application.VBE.MainWindow.Visible = False

au début de la procédure SupprimerMacros pour éviter le clignotement
intempestif de l'écran.

Cordialement,

Manu/


"JulieH"
Après essai, cela ne fonctionne pas complètement.

J'ai une erreur d'execution 9 "L'indice n'appartient pas à la sélection"
et la Macro bloque sur la ligne suivante :
With Workbooks(NomClasseur).VBProject 'supprime les macros
J'ai changé NomClasseur pour le nom du fichier en cours. Sans succès.

Merci pour vos idées.

Julie


Bonjour,

Les procédures suivantes doivent prendre place dans le même module (ici
nommé Module1) du classeur qui doit se saborder.

Bonne chance,

Manu/

Sub MacroSuicide()
Dim NomFichierModule As String
Application.ScreenUpdating = False
'Ajoute un classeur temporaire
Workbooks.Add
'Exporte ce module
With ThisWorkbook
NomFichierModule = .Path & "Module1.bas"
.VBProject.VBComponents("Module1").Export NomFichierModule
End With
'Copie ce module dans le classeur temporaire
ActiveWorkbook.VBProject.VBComponents.Import NomFichierModule
'Supprime le fichier module temporaire
Kill NomFichierModule
'Programme la procedure de suppression
Application.Run ActiveWorkbook.Name & "!" & "Attendre",
Left(ThisWorkbook.Name, Len(ThisWorkbook.Name) - 4)
'Termine le programme exécuté par ce classeur
End
End Sub

Sub Attendre(NomClasseur As String)
Application.OnTime Now + TimeValue("00:00:01"), "'SupprimerMacros """
& NomClasseur & """'"
End Sub

Sub SupprimerMacros(NomClasseur As String)
Dim VBC As Object
Application.ScreenUpdating = False
With Workbooks(NomClasseur).VBProject 'supprime les macros
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
Workbooks(NomClasseur).Save 'enregistre le classeur
ThisWorkbook.Close False 'ferme classeur temporaire
End Sub


"JulieH"
Bonjour,

Je cherche à effacer tout le code du fichier en cours. Pour cela,
j'utilise le code suivant :

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
ActiveWorkbook.Save


Tout fonctionne bien car après avoir lancer la macro, j'ai bien le
résultat escompté.

Cependant, lorsque je ferme le fichier, sans n'avoir fait aucune autre
manip, il me demande si je veux enregistrer :
- Si je réponds "oui", pas de problème le fichier n'a plus de code.
- Si je réponds "non", le code réapparaît. Il n'a pas pris en compte le
"save", ce qui semble assez logique étant donné que la macro elle-même
n'existe plus.

Ce que je souhaite : effacer le code, enregistrer immédiatement le
fichier pour que le code disparaissent définitivement, garder le fichier
ouvert (si possible).

Merci de vos idées.

Julie











MichDenis
Le #4596641
Barre de menus / outils / macro / sécurités / onglets Éditeurs approuvés
cocher les 2 cases à cocher dans le bas de la fenêtre.


"Ulysse"
bonjour à toutes et à tous

Je suis intéressé par ton Code Tissot.Emanuel, cependant j'ai une erreur
d'éxécution
L'accès par programme au projet Visual Basic n'est pas fiable
la ligne incriminée est :
.VBProject.VBComponents("Module1").Export NomFichierModule

merci de me débloquer


Bonjour,

Pour reproduire l'erreur j'ai du exécuter le code dans un nouveau classeur
sans l'avoir jamais enregistré auparavant. Dans ce cas le nom de classeur
passé à la procédure est incorrecte puisque tronqué d'une extension (.xls)
qui n'existe pas par la ligne suivante.

Application.Run ActiveWorkbook.Name & "!" & "Attendre",
Left(ThisWorkbook.Name, Len(ThisWorkbook.Name) - 4)

A la réflexion je me demande bien pourquoi je faisais ca...

Tu peux modifier cette ligne ainsi:

Application.Run ActiveWorkbook.Name & "!" & "Attendre", ThisWorkbook.Name

ou enregistrer ton classeur avant de lancer le test.

Et tant que je suis la, tu peux ajouter:

Application.VBE.MainWindow.Visible = False

au début de la procédure SupprimerMacros pour éviter le clignotement
intempestif de l'écran.

Cordialement,

Manu/


"JulieH"
Après essai, cela ne fonctionne pas complètement.

J'ai une erreur d'execution 9 "L'indice n'appartient pas à la sélection"
et la Macro bloque sur la ligne suivante :
With Workbooks(NomClasseur).VBProject 'supprime les macros
J'ai changé NomClasseur pour le nom du fichier en cours. Sans succès.

Merci pour vos idées.

Julie


Bonjour,

Les procédures suivantes doivent prendre place dans le même module (ici
nommé Module1) du classeur qui doit se saborder.

Bonne chance,

Manu/

Sub MacroSuicide()
Dim NomFichierModule As String
Application.ScreenUpdating = False
'Ajoute un classeur temporaire
Workbooks.Add
'Exporte ce module
With ThisWorkbook
NomFichierModule = .Path & "Module1.bas"
.VBProject.VBComponents("Module1").Export NomFichierModule
End With
'Copie ce module dans le classeur temporaire
ActiveWorkbook.VBProject.VBComponents.Import NomFichierModule
'Supprime le fichier module temporaire
Kill NomFichierModule
'Programme la procedure de suppression
Application.Run ActiveWorkbook.Name & "!" & "Attendre",
Left(ThisWorkbook.Name, Len(ThisWorkbook.Name) - 4)
'Termine le programme exécuté par ce classeur
End
End Sub

Sub Attendre(NomClasseur As String)
Application.OnTime Now + TimeValue("00:00:01"), "'SupprimerMacros """
& NomClasseur & """'"
End Sub

Sub SupprimerMacros(NomClasseur As String)
Dim VBC As Object
Application.ScreenUpdating = False
With Workbooks(NomClasseur).VBProject 'supprime les macros
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
Workbooks(NomClasseur).Save 'enregistre le classeur
ThisWorkbook.Close False 'ferme classeur temporaire
End Sub


"JulieH"
Bonjour,

Je cherche à effacer tout le code du fichier en cours. Pour cela,
j'utilise le code suivant :

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
ActiveWorkbook.Save


Tout fonctionne bien car après avoir lancer la macro, j'ai bien le
résultat escompté.

Cependant, lorsque je ferme le fichier, sans n'avoir fait aucune autre
manip, il me demande si je veux enregistrer :
- Si je réponds "oui", pas de problème le fichier n'a plus de code.
- Si je réponds "non", le code réapparaît. Il n'a pas pris en compte le
"save", ce qui semble assez logique étant donné que la macro elle-même
n'existe plus.

Ce que je souhaite : effacer le code, enregistrer immédiatement le
fichier pour que le code disparaissent définitivement, garder le fichier
ouvert (si possible).

Merci de vos idées.

Julie











Publicité
Poster une réponse
Anonyme