Sup Macro

| workbooks beforeclose et qu'il ne peut se supprimer car il est encore ouvert.

Tu mets tout le code qui suit dans le ThisWorkbook de ton classeur.
Çafonctionne très bien !


Private Sub Workbook_BeforeClose(Cancel As Boolean)

Dim Fichier As String
Fichier = ThisWorkbook.Name ' Ou le nom d'un autre fichier
SupprimeToutCodeEtFormulair Fichier
Workbooks(Fichier).Save

End Sub
'---------------------------
Sub SupprimeToutCodeEtFormulaire(NomFichier As String)

Dim VBComp As Object
Dim VBComps As Object

Set VBComps = Workbooks(NomFichier).VBProject.VBComponents

For Each VBComp In VBComps
Select Case VBComp.Type
Case 100
With VBComp.CodeModule
.DeleteLines 1, .CountOfLines
End With
Case Else
VBComps.Remove VBComp
End Select
Next VBComp

End Sub

Alors, j'ai mis dans un module :

Sub SupprimeToutCodeEtFormulaire(NomFichier As string)

Dim VBComp As Object
Dim VBComps As Object

Set VBComps = Workbooks(NomFichier).VBProject.VBComponents

For Each VBComp In VBComps
Select Case VBComp.Type
Case 100
With VBComp.CodeModule
.DeleteLines 1, .CountOfLines
End With
Case Else
VBComps.Remove VBComp
End Select
Next VBComp

End Sub

Puis inserer à la fin de ma macro workbooks beforeclose :

Repertoire = "C:Documents and SettingsAdministrateur"

Fichier = "zaza" & _
" - " & Cells(11, 2).Value & "-" & Day(Now) & _
"-" & Month(Now) & "-" & Year(Now) & ".xls"

'Enregistre le fichier en cours sous son nouveau nom
ThisWorkbook.SaveAs Repertoire & Fichier

'Cette ligne appelle la procédure qui détruira toutes tes procédures.
SupprimeToutCodeEtFormulaire Fichier

'Enregistre ton fichier après avoir effacé le code.
Workbooks(Fichier).Save

Et ca bloque sur la ligne : SupprimeToutCodeEtFormulaire Fichier

Je n'ai pas remis
Dim Repertoire As Stringe
Dim Fichier As String
car ils existaient deja

Ais je bien fait la bonne procedure ?

"MichDenis" <michdenis@hotmail.com> a écrit dans le message de news:
OwMD$LPNHHA.1816@TK2MSFTNGP06.phx.gbl...

'----------------------
Sub TaSub()

Dim Repertoire as String
Dim Fichier As string

Repertoire = "C:Documents and SettingsAdministrateur"

fichier = "zaza" & _
" - " & Cells(11, 2).Value & "-" & Day(Now) & _
"-" & Month(Now) & "-" & Year(Now) & ".xls"

'Enregistre le fichier en cours sous son nouveau nom
ThisWorkbook.Saveas Repertoire & fichier

'Cette ligne appelle la procédure qui détruira toutes tes procédures.
SupprimeToutCodeEtFormulaire fichier

'Enregistre ton fichier après avoir effacé le code.
Workbooks(fichier).Save

End Sub
'----------------------


'--------------------------------
Sub SupprimeToutCodeEtFormulaire(NomFichier As string)

Dim VBComp As Object
Dim VBComps As Object

Set VBComps = Workbooks(NomFichier).VBProject.VBComponents

For Each VBComp In VBComps
Select Case VBComp.Type
Case 100
With VBComp.CodeModule
.DeleteLines 1, .CountOfLines
End With
Case Else
VBComps.Remove VBComp
End Select
Next VBComp

End Sub
'--------------------------------




"Manu" <manuel.gamin@wanadoo.fr> a écrit dans le message de news:
%23jtOniONHHA.3668@TK2MSFTNGP02.phx.gbl...
En fait, mon fichier se crée comme ca :
Repertoire = "C:Documents and SettingsAdministrateur"
fichier = "zaza" & _
" - " & Cells(11, 2).Value & "-" & Day(Now) & _
"-" & Month(Now) & "-" & Year(Now) & ".xls"
et par consequent je souhaite supprimer toutes les macros de ce fichier
(mais ce n'est jamais le meme nom)

Ais je été clair ?


"MichDenis" <michdenis@hotmail.com> a écrit dans le message de news:
ekXFBZONHHA.140@TK2MSFTNGP04.phx.gbl...

J'ai ajouté une variable à partir de laquelle tu peux définir
le nom du fichier que tu désires.


'-----------------------------------
Sub EffacerProcédure()

Dim DeleteSubName As String
Dim ModuleName As String
Dim Fichier As String
'Variable à renseigner
DeleteSubName = "Sub Workbook_Open"
ModuleName = "ThisWorkbook"
Fichier = ThisWorkbook.Name
SupprimerProcédure Fichier, DeleteSubName, ModuleName

End Sub
'----------------------------------
Sub SupprimerProcédure(NomFichier As String, _
SonNom As String, SonModule As String)

Dim Début As Integer, Fin As Integer
Dim A As Integer, B As Integer, Nb As Integer
Dim Comp As Object

With Workbooks(NomFichier).VBProject.VBComponents _
(SonModule).CodeModule
Nb = .CountOfLines
For A = 1 To Nb
If InStr(1, .Lines(A, 1), SonNom, _
vbTextCompare) <> 0 Then
Début = A
For B = A + 1 To Nb
If InStr(1, .Lines(B, 1), "End Sub", _
vbTextCompare) <> 0 Then
Fin = B - Début + 1
Exit For
End If
Next
If Fin <> 0 Then
.DeleteLines Début, Fin
Exit Sub
End If
End If
Next
End With
End Sub







"Manu" <manuel.gamin@wanadoo.fr> a écrit dans le message de news:
evIGZRONHHA.2236@TK2MSFTNGP02.phx.gbl...
Merci,
En fait mon fichier porte une variable "fichier" que dois je lui dire ?
Ce que tu as mis :
Set VBComps = Workbooks("NomDuClasseur.xls").VBProject.VBComponents
Ce que j'essais :
Set VBComps = ActiveWorkbook = fichier.VBProject.VBComponents

Mais ca ne fonctionne evidemment pas
Que puis je faire ?

"MichDenis" <michdenis@hotmail.com> a écrit dans le message de news:
eiKjf$NNHHA.1872@TK2MSFTNGP04.phx.gbl...

Pour supprimer n'importe quelle procédure d'un module quelconque, tu
appelles la
procédure "Effacer procédure" et tu renseignes les 2 variables :

A ) le nom de la procédure à effacer
B ) le nom du module où elle est située.

Ces 2 Procédures sont à copiées dans un module Standard.

'----------------------------------
Sub EffacerProcédure()

Dim DeleteSubName As String
Dim ModuleName As String
'Variable à renseigner
DeleteSubName = "Sub Workbook_Open"
ModuleName = "ThisWorkbook"
SupprimerProcédure DeleteSubName, ModuleName

End Sub
'----------------------------------
Sub SupprimerProcédure(SonNom As String, SonModule As String)

Dim Début As Integer, Fin As Integer
Dim A As Integer, B As Integer, Nb As Integer
Dim Comp As Object

With ThisWorkbook.VBProject.VBComponents _
(SonModule).CodeModule
Nb = .CountOfLines
For A = 1 To Nb
If InStr(1, .Lines(A, 1), SonNom, _
vbTextCompare) <> 0 Then
Début = A
For B = A + 1 To Nb
If InStr(1, .Lines(B, 1), "End Sub", _
vbTextCompare) <> 0 Then
Fin = B - Début + 1
Exit For
End If
Next
If Fin <> 0 Then
.DeleteLines Début, Fin
Exit Sub
End If
End If
Next
End With
End Sub

'----------------------------------






"Manu" <manuel.gamin@wanadoo.fr> a écrit dans le message de news:
u5MN1CNNHHA.448@TK2MSFTNGP04.phx.gbl...
Est t'il possible dans une macro d'en supprimer d'autres du meme
fichier,
voir meme d'auto supprimer automatiquement une macro lorsqu'elle à fini
son
boulot.

Sub test()
-----
etc -----
----
-----
Sup cette macro en cours

Merci

Manu

Voici ci dessous mon code en sachant que je part d'un modele toto.xlt

Private Sub Workbook_BeforeClose(Cancel As Boolean)

Dim liDeb, NbLi


'test si On valide ou pas
Msg = MsgBox("Voulez-Vous mettre à jour votre BDD et votre historique ?", 4)
If Msg = 6 Then

'Enregistre le fichier en commencant par zaza + jour + mois + année
Repertoire = "C:Documents and SettingsAdministrateur"
Fichier = "zaza" & _
" - " & Cells(11, 2).Value & "-" & Day(Now) & _
"-" & Month(Now) & "-" & Year(Now) & ".xls"

ActiveWorkbook.SaveAs Filename:=Repertoire & Fichier
-----
----
----
---

'Réactive le fichier dans l'historique
Workbooks(Fichier).Activate

----
-----
-------
----
---
-----



Repertoire = "C:Documents and SettingsAdministrateur"

Fichier = "zaza" & _
" - " & Cells(11, 2).Value & "-" & Day(Now) & _
"-" & Month(Now) & "-" & Year(Now) & ".xls"

'Enregistre le fichier en cours sous son nouveau nom
ThisWorkbook.SaveAs Repertoire & Fichier

'Cette ligne appelle la procédure qui détruira toutes tes procédures.
SupprimeToutCodeEtFormulaire Fichier

'Enregistre ton fichier après avoir effacé le code.
Workbooks(Fichier).Save

End If

End Sub


"MichDenis" <michdenis@hotmail.com> a écrit dans le message de news:
OwMD$LPNHHA.1816@TK2MSFTNGP06.phx.gbl...

'----------------------
Sub TaSub()

Dim Repertoire as String
Dim Fichier As string

Repertoire = "C:Documents and SettingsAdministrateur"

fichier = "zaza" & _
" - " & Cells(11, 2).Value & "-" & Day(Now) & _
"-" & Month(Now) & "-" & Year(Now) & ".xls"

'Enregistre le fichier en cours sous son nouveau nom
ThisWorkbook.Saveas Repertoire & fichier

'Cette ligne appelle la procédure qui détruira toutes tes procédures.
SupprimeToutCodeEtFormulaire fichier

'Enregistre ton fichier après avoir effacé le code.
Workbooks(fichier).Save

End Sub
'----------------------


'--------------------------------
Sub SupprimeToutCodeEtFormulaire(NomFichier As string)

Dim VBComp As Object
Dim VBComps As Object

Set VBComps = Workbooks(NomFichier).VBProject.VBComponents

For Each VBComp In VBComps
Select Case VBComp.Type
Case 100
With VBComp.CodeModule
.DeleteLines 1, .CountOfLines
End With
Case Else
VBComps.Remove VBComp
End Select
Next VBComp

End Sub
'--------------------------------




"Manu" <manuel.gamin@wanadoo.fr> a écrit dans le message de news:
%23jtOniONHHA.3668@TK2MSFTNGP02.phx.gbl...
En fait, mon fichier se crée comme ca :
Repertoire = "C:Documents and SettingsAdministrateur"
fichier = "zaza" & _
" - " & Cells(11, 2).Value & "-" & Day(Now) & _
"-" & Month(Now) & "-" & Year(Now) & ".xls"
et par consequent je souhaite supprimer toutes les macros de ce fichier
(mais ce n'est jamais le meme nom)

Ais je été clair ?


"MichDenis" <michdenis@hotmail.com> a écrit dans le message de news:
ekXFBZONHHA.140@TK2MSFTNGP04.phx.gbl...

J'ai ajouté une variable à partir de laquelle tu peux définir
le nom du fichier que tu désires.


'-----------------------------------
Sub EffacerProcédure()

Dim DeleteSubName As String
Dim ModuleName As String
Dim Fichier As String
'Variable à renseigner
DeleteSubName = "Sub Workbook_Open"
ModuleName = "ThisWorkbook"
Fichier = ThisWorkbook.Name
SupprimerProcédure Fichier, DeleteSubName, ModuleName

End Sub
'----------------------------------
Sub SupprimerProcédure(NomFichier As String, _
SonNom As String, SonModule As String)

Dim Début As Integer, Fin As Integer
Dim A As Integer, B As Integer, Nb As Integer
Dim Comp As Object

With Workbooks(NomFichier).VBProject.VBComponents _
(SonModule).CodeModule
Nb = .CountOfLines
For A = 1 To Nb
If InStr(1, .Lines(A, 1), SonNom, _
vbTextCompare) <> 0 Then
Début = A
For B = A + 1 To Nb
If InStr(1, .Lines(B, 1), "End Sub", _
vbTextCompare) <> 0 Then
Fin = B - Début + 1
Exit For
End If
Next
If Fin <> 0 Then
.DeleteLines Début, Fin
Exit Sub
End If
End If
Next
End With
End Sub







"Manu" <manuel.gamin@wanadoo.fr> a écrit dans le message de news:
evIGZRONHHA.2236@TK2MSFTNGP02.phx.gbl...
Merci,
En fait mon fichier porte une variable "fichier" que dois je lui dire ?
Ce que tu as mis :
Set VBComps = Workbooks("NomDuClasseur.xls").VBProject.VBComponents
Ce que j'essais :
Set VBComps = ActiveWorkbook = fichier.VBProject.VBComponents

Mais ca ne fonctionne evidemment pas
Que puis je faire ?

"MichDenis" <michdenis@hotmail.com> a écrit dans le message de news:
eiKjf$NNHHA.1872@TK2MSFTNGP04.phx.gbl...

Pour supprimer n'importe quelle procédure d'un module quelconque, tu
appelles la
procédure "Effacer procédure" et tu renseignes les 2 variables :

A ) le nom de la procédure à effacer
B ) le nom du module où elle est située.

Ces 2 Procédures sont à copiées dans un module Standard.

'----------------------------------
Sub EffacerProcédure()

Dim DeleteSubName As String
Dim ModuleName As String
'Variable à renseigner
DeleteSubName = "Sub Workbook_Open"
ModuleName = "ThisWorkbook"
SupprimerProcédure DeleteSubName, ModuleName

End Sub
'----------------------------------
Sub SupprimerProcédure(SonNom As String, SonModule As String)

Dim Début As Integer, Fin As Integer
Dim A As Integer, B As Integer, Nb As Integer
Dim Comp As Object

With ThisWorkbook.VBProject.VBComponents _
(SonModule).CodeModule
Nb = .CountOfLines
For A = 1 To Nb
If InStr(1, .Lines(A, 1), SonNom, _
vbTextCompare) <> 0 Then
Début = A
For B = A + 1 To Nb
If InStr(1, .Lines(B, 1), "End Sub", _
vbTextCompare) <> 0 Then
Fin = B - Début + 1
Exit For
End If
Next
If Fin <> 0 Then
.DeleteLines Début, Fin
Exit Sub
End If
End If
Next
End With
End Sub

'----------------------------------






"Manu" <manuel.gamin@wanadoo.fr> a écrit dans le message de news:
u5MN1CNNHHA.448@TK2MSFTNGP04.phx.gbl...
Est t'il possible dans une macro d'en supprimer d'autres du meme
fichier,
voir meme d'auto supprimer automatiquement une macro lorsqu'elle à fini
son
boulot.

Sub test()
-----
etc -----
----
-----
Sup cette macro en cours

Merci

Manu

Quelle patience tu as, merci encore.

Je n'arrive pas à savoir ou je dois integrer tes 2 codes dans ma macro car
si je copie ton code sous le mien, ca fais deux macros workbooks
before_close et là il me bug en parlant d'ambiguité.

Je ne sais pas ou installer tous ca dans mon code actuel, là est le probleme
Manu

"MichDenis" <michdenis@hotmail.com> a écrit dans le message de news:
%23kMpdTPNHHA.5000@TK2MSFTNGP03.phx.gbl...

| workbooks beforeclose et qu'il ne peut se supprimer car il est encore
ouvert.

Tu mets tout le code qui suit dans le ThisWorkbook de ton classeur.
Çafonctionne très bien !


Private Sub Workbook_BeforeClose(Cancel As Boolean)

Dim Fichier As String
Fichier = ThisWorkbook.Name ' Ou le nom d'un autre fichier
SupprimeToutCodeEtFormulair Fichier
Workbooks(Fichier).Save

End Sub
'---------------------------
Sub SupprimeToutCodeEtFormulaire(NomFichier As String)

Dim VBComp As Object
Dim VBComps As Object

Set VBComps = Workbooks(NomFichier).VBProject.VBComponents

For Each VBComp In VBComps
Select Case VBComp.Type
Case 100
With VBComp.CodeModule
.DeleteLines 1, .CountOfLines
End With
Case Else
VBComps.Remove VBComp
End Select
Next VBComp

End Sub

En fait, tu insères ces 3 lignes dans ta procédure, tu n'as
qu'à renseigner la variable Fichier par le nom du fichier
où tu veux éliminer les macros. Elle est où la difficulté ?

Dim Fichier As String
Fichier = ThisWorkbook.Name ' Ou le nom d'un autre fichier
SupprimeToutCodeEtFormulair Fichier


'Habituellement, ce code devrait être dans un module standard...
'Mais tu peux le mettre dans le ThisWorkbook... il ne s'exécutera
'qu'une fois.
'---------------------------
Sub SupprimeToutCodeEtFormulaire(NomFichier As String)

Dim VBComp As Object
Dim VBComps As Object

Set VBComps = Workbooks(NomFichier).VBProject.VBComponents

For Each VBComp In VBComps
Select Case VBComp.Type
Case 100
With VBComp.CodeModule
.DeleteLines 1, .CountOfLines
End With
Case Else
VBComps.Remove VBComp
End Select
Next VBComp

End Sub
'---------------------------------------

Bonjour,

j'ai intégré cela dans ma macro :
Dim nomFichier As String
nomFichier = ThisWorkbook.Name
SupprimeToutCodeEtFormulaire nomFichier

puis cela egalement dans thisworkbook :
Sub SupprimeToutCodeEtFormulaire(nomFichier As String)
Dim VBComp As Object
Dim VBComps As Object
Set VBComps = Workbooks(nomFichier).VBProject.VBComponents
For Each VBComp In VBComps
Select Case VBComp.Type
Case 100
With VBComp.CodeModule
.DeleteLines 1, .CountOfLines
End With
Case Else
VBComps.Remove VBComp
End Select
Next VBComp
End Sub


Il bloque sur : Set VBComps = Workbooks(nomFichier).VBProject.VBComponents
il dit dans l'info bulle : la methode vbproject de l'objet workbook à
échoué.


"MichDenis" <michdenis@hotmail.com> a écrit dans le message de news:
OmCzsFQNHHA.1276@TK2MSFTNGP04.phx.gbl...

En fait, tu insères ces 3 lignes dans ta procédure, tu n'as
qu'à renseigner la variable Fichier par le nom du fichier
où tu veux éliminer les macros. Elle est où la difficulté ?

Dim Fichier As String
Fichier = ThisWorkbook.Name ' Ou le nom d'un autre fichier
SupprimeToutCodeEtFormulair Fichier


'Habituellement, ce code devrait être dans un module standard...
'Mais tu peux le mettre dans le ThisWorkbook... il ne s'exécutera
'qu'une fois.
'---------------------------
Sub SupprimeToutCodeEtFormulaire(NomFichier As String)

Dim VBComp As Object
Dim VBComps As Object

Set VBComps = Workbooks(NomFichier).VBProject.VBComponents

For Each VBComp In VBComps
Select Case VBComp.Type
Case 100
With VBComp.CodeModule
.DeleteLines 1, .CountOfLines
End With
Case Else
VBComps.Remove VBComp
End Select
Next VBComp

End Sub
'---------------------------------------

J'ai meme essayé sur un nouveau fichier cette macro tiré de frederic
sigonneau et ca bloque tjrs sur
With ThisWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule
Je ne comprend pas !


'Une solution est de supprimer le code de la macro après son exécution. Ça
peut
'se faire dans les instructions de la macro elle-même. Par exemple, pour
exécuter
'une instruction à l'ouverture du classeur (écrire dans une cellule) puis
'supprimer la procédure Workbook_Open, recopie ce code dans le module
ThisWorkbook :
Private Sub Workbook_Open()
Dim liDeb, NbLi

'exécute une action à l'ouverture
Msg = "La procédure Workbook_Open a été exécutée"
ActiveSheet.Range("A1").Value = Msg

'détruit la procédure
'(l'action ne sera donc exécutée qu'une seule fois)
With ThisWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule
liDeb = .ProcStartLine("Workbook_Open", 0)
NbLi = .ProcCountLines("Workbook_Open", 0)
.DeleteLines liDeb, NbLi
End With

End Sub
"Manu" <manuel.gamin@wanadoo.fr> a écrit dans le message de news:
uVscoxUNHHA.320@TK2MSFTNGP06.phx.gbl...

Bonjour,

j'ai intégré cela dans ma macro :
Dim nomFichier As String
nomFichier = ThisWorkbook.Name
SupprimeToutCodeEtFormulaire nomFichier

puis cela egalement dans thisworkbook :
Sub SupprimeToutCodeEtFormulaire(nomFichier As String)
Dim VBComp As Object
Dim VBComps As Object
Set VBComps = Workbooks(nomFichier).VBProject.VBComponents
For Each VBComp In VBComps
Select Case VBComp.Type
Case 100
With VBComp.CodeModule
.DeleteLines 1, .CountOfLines
End With
Case Else
VBComps.Remove VBComp
End Select
Next VBComp
End Sub


Il bloque sur : Set VBComps = Workbooks(nomFichier).VBProject.VBComponents
il dit dans l'info bulle : la methode vbproject de l'objet workbook à
échoué.


"MichDenis" <michdenis@hotmail.com> a écrit dans le message de news:
OmCzsFQNHHA.1276@TK2MSFTNGP04.phx.gbl...

En fait, tu insères ces 3 lignes dans ta procédure, tu n'as
qu'à renseigner la variable Fichier par le nom du fichier
où tu veux éliminer les macros. Elle est où la difficulté ?

Dim Fichier As String
Fichier = ThisWorkbook.Name ' Ou le nom d'un autre fichier
SupprimeToutCodeEtFormulair Fichier


'Habituellement, ce code devrait être dans un module standard...
'Mais tu peux le mettre dans le ThisWorkbook... il ne s'exécutera
'qu'une fois.
'---------------------------
Sub SupprimeToutCodeEtFormulaire(NomFichier As String)

Dim VBComp As Object
Dim VBComps As Object

Set VBComps = Workbooks(NomFichier).VBProject.VBComponents

For Each VBComp In VBComps
Select Case VBComp.Type
Case 100
With VBComp.CodeModule
.DeleteLines 1, .CountOfLines
End With
Case Else
VBComps.Remove VBComp
End Select
Next VBComp

End Sub
'---------------------------------------

J'ai trouvé de ou provient le probleme, meme si je n'ai pas reussi à le
résoudre. Les codes que tu m'as donné fonctionne tres bien mais sur la
version 2000 et moi je suis sur 2003 et là ca ne fonctionne plus.
Y a t'il une bricole à changer pour la V2003 ?

Manu

"Manu" <manuel.gamin@wanadoo.fr> a écrit dans le message de news:
uomdU$UNHHA.4172@TK2MSFTNGP03.phx.gbl...

J'ai meme essayé sur un nouveau fichier cette macro tiré de frederic
sigonneau et ca bloque tjrs sur
With ThisWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule
Je ne comprend pas !


'Une solution est de supprimer le code de la macro après son exécution. Ça
peut
'se faire dans les instructions de la macro elle-même. Par exemple, pour
exécuter
'une instruction à l'ouverture du classeur (écrire dans une cellule) puis
'supprimer la procédure Workbook_Open, recopie ce code dans le module
ThisWorkbook :
Private Sub Workbook_Open()
Dim liDeb, NbLi

'exécute une action à l'ouverture
Msg = "La procédure Workbook_Open a été exécutée"
ActiveSheet.Range("A1").Value = Msg

'détruit la procédure
'(l'action ne sera donc exécutée qu'une seule fois)
With ThisWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule
liDeb = .ProcStartLine("Workbook_Open", 0)
NbLi = .ProcCountLines("Workbook_Open", 0)
.DeleteLines liDeb, NbLi
End With

End Sub
"Manu" <manuel.gamin@wanadoo.fr> a écrit dans le message de news:
uVscoxUNHHA.320@TK2MSFTNGP06.phx.gbl...

Bonjour,

j'ai intégré cela dans ma macro :
Dim nomFichier As String
nomFichier = ThisWorkbook.Name
SupprimeToutCodeEtFormulaire nomFichier

puis cela egalement dans thisworkbook :
Sub SupprimeToutCodeEtFormulaire(nomFichier As String)
Dim VBComp As Object
Dim VBComps As Object
Set VBComps = Workbooks(nomFichier).VBProject.VBComponents
For Each VBComp In VBComps
Select Case VBComp.Type
Case 100
With VBComp.CodeModule
.DeleteLines 1, .CountOfLines
End With
Case Else
VBComps.Remove VBComp
End Select
Next VBComp
End Sub


Il bloque sur : Set VBComps =
Workbooks(nomFichier).VBProject.VBComponents
il dit dans l'info bulle : la methode vbproject de l'objet workbook à
échoué.


"MichDenis" <michdenis@hotmail.com> a écrit dans le message de news:
OmCzsFQNHHA.1276@TK2MSFTNGP04.phx.gbl...

En fait, tu insères ces 3 lignes dans ta procédure, tu n'as
qu'à renseigner la variable Fichier par le nom du fichier
où tu veux éliminer les macros. Elle est où la difficulté ?

Dim Fichier As String
Fichier = ThisWorkbook.Name ' Ou le nom d'un autre fichier
SupprimeToutCodeEtFormulair Fichier


'Habituellement, ce code devrait être dans un module standard...
'Mais tu peux le mettre dans le ThisWorkbook... il ne s'exécutera
'qu'une fois.
'---------------------------
Sub SupprimeToutCodeEtFormulaire(NomFichier As String)

Dim VBComp As Object
Dim VBComps As Object

Set VBComps = Workbooks(NomFichier).VBProject.VBComponents

For Each VBComp In VBComps
Select Case VBComp.Type
Case 100
With VBComp.CodeModule
.DeleteLines 1, .CountOfLines
End With
Case Else
VBComps.Remove VBComp
End Select
Next VBComp

End Sub
'---------------------------------------

| Les codes que tu m'as donné fonctionne tres bien mais sur la
| version 2000 et moi je suis sur 2003 et là ca ne fonctionne plus.
| Y a t'il une bricole à changer pour la V2003 ?

T'es pas chanceux, je travaille à partir d'une version 2003 et je n'ai
aucun problème à les exécuter.

Coches les 2 items situés là si ce n'est déjà fait :
Barre des menus de la feuille de calcul / outils / Macro / Sécurité /
Onglet- Éditeurs approuvés / et tu coches les 2 options dans le bas
de la fenêtre.

Ouffffffffffffffffffffffff et vraiment un grand merci Mich, c'etait ca, la
derniere case de la sécurité etait décoché, dés que je l'ai coché, ca à
fonctionné du 1er coup !!!! Je m'en rappelerai de cette case !!!
merci encore de ta pertinence.

Manu

"MichDenis" <michdenis@hotmail.com> a écrit dans le message de news:
%23nAe59XNHHA.448@TK2MSFTNGP04.phx.gbl...

| Les codes que tu m'as donné fonctionne tres bien mais sur la
| version 2000 et moi je suis sur 2003 et là ca ne fonctionne plus.
| Y a t'il une bricole à changer pour la V2003 ?

T'es pas chanceux, je travaille à partir d'une version 2003 et je n'ai
aucun problème à les exécuter.

Coches les 2 items situés là si ce n'est déjà fait :
Barre des menus de la feuille de calcul / outils / Macro / Sécurité /
Onglet- Éditeurs approuvés / et tu coches les 2 options dans le bas
de la fenêtre.