VBA - procédure pour efface toutes les macros

[Jean P]

Bonjour à tous

Situation: avec l'aide du forum j'ai réussi à faire une marco qui me permet de faire une copie de plusieurs fichiers.

Problématique: je voudrais dans la copie des nouveaux fichiers supprimer le code vba qui si trouve.

Est-ce possible ?

Je vous remercie d'avance pour vos conseils.

Bonne journée


Jean P

 

[@+Thierry]

Bonjour Jean, le Forum,

Un code de mon copain @Xtof@, à manipuler avec précaution...

Sub MacroKiller()
Dim VBC As Object, Wbk As Workbook

Set Wbk = Workbooks("New.xls")
Wbk.VBProject.VBComponents

With Wbk.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


Bonne Journée (T.G.I.F. !!!)
@+Thierry

 

[Jean P]

Bonjour Thierry et au forum

Je te remercie pour la réponse mais j'ai un petit problème.

A chaque mois, j'archive trois fichiers (compilation mensuelle, historique cartierville et historique ste-rose).

J'ai intégré ton code dans la procédure suivante et j'ai un message d'erreur avec la ligne suivante: Wbk.VBProject.VBComponents

Existe-il une autre façon pour effacer le code qui se trouve dans les nouveaux fichiers ?

Private Sub CommandButton1_Click()
'Code pour le transfert du choix du combobox1 vers la cellule H1
Dim ChoixMois As String
With Sheets("Menu")
If Me.ComboBox1 <> "" Then
End If
.Range("H1") = Me.ComboBox1
End With
With ComboBox1
.Value = ""
.SetFocus
End With
ChoixMois = Range("H1")
'Code pour la msgbox
Dim Msg, Style, Title, Response, MyString
Msg = "Michel" & Chr(10) & Chr(10) & " Veux-tu archiver les données du mois de " & ChoixMois & " ? "
Style = vbYesNoCancel + vbQuestion + vbDefaultButton2
Title = "© JEAN PLANTE - Backup du dernier mois "
Response = MsgBox(Msg, Style, Title)
'Code si la réponse est OUI
If Response = vbYes Then
MyString = "Oui"
Workbooks.Open Filename:="C:\Laiterie Michel\Historique Cartierville.xls"
Workbooks("Historique Cartierville.xls").SaveAs ("C:\Laiterie Michel\backup 2004\" & ChoixMois & " Historique Cartierville")
Workbooks(ChoixMois & " Historique Cartierville.xls").Close
Workbooks.Open Filename:="C:\Laiterie Michel\Historique Ste-Rose.xls"
Workbooks("Historique Ste-Rose.xls").SaveAs ("C:\Laiterie Michel\backup 2004\" & ChoixMois & " Historique Ste-Rose")
Workbooks(ChoixMois & " Historique Ste-Rose.xls").Close
Workbooks("Compilation mensuelle.xls").SaveAs ("C:\Laiterie Michel\backup 2004\" & ChoixMois & " Compilation mensuelle")
Workbooks(ChoixMois & " Compilation mensuelle.xls").Close
Unload Me
'Code si la réponse est NON
ElseIf Response = vbNo Then
MyString = "Non"
Exit Sub
'Code si la réponse est ANNULER
Else
MyString = "Annuler"
Unload Me
Exit Sub
End If

'Code pour effacer les macro des fichiers archivés
Dim VBC As Object
Dim Wbk As Workbook
Set Wbk = Workbooks("C:\Laiterie Michel\backup 2004\" & ChoixMois & " Compilation mensuelle")
Wbk.VBProject.VBComponents
With Wbk.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


Encore une fois merci


Jean P

 

[Jean P]

Bonjour à tous

J'ai essayé plusieurs procédure et aucune n'arrive au bon résultat.

Je crois que je vais essayer de trouver une autre solution.

Si jamais quelqu'un à une solution à me proposer, je suis d'accord.

Encore une fois merci pour votre aide.


Jean P.

 

[Zon]

Salut,

Il y a une ligne de trop dans le code: Wbk.VBProject.VBComponents. Ensuite pour que Macrokiller fonctionne le fichier doit être ouvert.

En modiifiant ton code comme ceci en rajoutant 2 procédures:

'La 1ere on passe en paramettre le nom de fichier à ouvrir et son nouveau nom
sub OuvrirFichier(NomC$,NomSauv$)
dim C as workbook
on error resume next
set c= Workbooks.Open (Nomc)
on error goto 0
with C
.saveas Nomsauv
macrokiller .name
.close 1
end with
end sub

Sub MacroKiller(NomC$)
Dim VBC As Object, Wbk As Workbook

Set Wbk = Workbooks(NomC)
With Wbk.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


Ensuite dans le ode de ton USF:

If Response = vbYes Then
MyString = "Oui"
ouvrirfichier "C:\Laiterie Michel\Historique Cartierville.xls","C:\Laiterie Michel\backup 2004\" & ChoixMois & " Historique Cartierville"

ouvrirfichier "C:\Laiterie Michel\Historique Ste-Rose.xls","C:\Laiterie Michel\backup 2004\" & ChoixMois & " Historique Ste-Rose"

ouvrirfichier Activeworkbook.name, ("C:\Laiterie Michel\backup 2004\" & ChoixMois & " Compilation mensuelle")


End sub

A+++

Ps Bizarre que Thierry n'ait pas répondu, il doit être absent, il faut savoir être patient Jean P....

 

[Jean P]

Bonsoir Zon et le forum

Je te remrcie pour ta réponse mais je ne comprend pas très bien, je suis
désolé 🙁(.

Je n'arrive pas à faire fonctionner la procédure.

Donc, si j'ai bien compris:

A) Je créé un module avec le code suivant:
sub OuvrirFichier(NomC$,NomSauv$)
dim C as workbook
on error resume next
set c= Workbooks.Open (Nomc)
on error goto 0
with C
.saveas Nomsauv
macrokiller .name
.close 1
end with
end sub

B) Ensuite, je créé un autre module avec le code suivant:
Sub MacroKiller(NomC$)
Dim VBC As Object, Wbk As Workbook
Set Wbk = Workbooks(NomC)
With Wbk.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

C) Dans le code du usf je remplace les lignes suivantes:
If Response = vbYes Then
MyString = "Oui"
Workbooks.Open Filename:="C:\Laiterie Michel\Historique Cartierville.xls"
Workbooks("Historique Cartierville.xls").SaveAs ("C:\Laiterie Michel\backup 2004\" & ChoixMois & " Historique Cartierville")
Workbooks.Open Filename:="C:\Laiterie Michel\Historique Ste-Rose.xls"
Workbooks("Historique Ste-Rose.xls").SaveAs ("C:\Laiterie Michel\backup 2004\" & ChoixMois & " Historique Ste-Rose")
Workbooks("Compilation mensuelle.xls").SaveAs ("C:\Laiterie Michel\backup 2004\" & ChoixMois & " Compilation mensuelle")
Unload Me
Workbooks(ChoixMois & " Historique Cartierville.xls").Close SaveChanges:=True
Workbooks(ChoixMois & " Historique Ste-Rose.xls").Close SaveChanges:=True
Workbooks(ChoixMois & " Compilation mensuelle.xls").Close SaveChanges:=True

par celle-ci:
If Response = vbYes Then
MyString = "Oui"
ouvrirfichier "C:\Laiterie Michel\Historique Cartierville.xls","C:\Laiterie Michel\backup 2004\" & ChoixMois & " Historique Cartierville"
ouvrirfichier "C:\Laiterie Michel\Historique Ste-Rose.xls","C:\Laiterie Michel\backup 2004\" & ChoixMois & " Historique Ste-Rose"
ouvrirfichier Activeworkbook.name, ("C:\Laiterie Michel\backup 2004\" & ChoixMois & " Compilation mensuelle")

D) Question: quand est-ce que tu appelles (call) les deux nouvelles procédures?

Je te remercie pour ton aide.

Jean P.

 

[Zon]

Re,

Quand j'écris:
ouvrirfichier "C:\Laiterie Michel\Historique Ste-Rose.xls","C:\Laiterie Michel\backup 2004\" & ChoixMois & " Historique Ste-Rose" 'le call est sous entendu
c'est identique à
call ouvrirfichier ("C:\Laiterie Michel\Historique Ste-Rose.xls","C:\Laiterie Michel\backup 2004\" & ChoixMois & " Historique Ste-Rose")

Pas besoin de mettre ces 2 procédures dans 2 modules différents, tu peux même les mettre dans le module de l'userform.


A+++

 

[@+Thierry]

Bonjour Zon, Jean, le Forum

Oui j'étais un peu en vadrouille avec ce long week end ! je n'ai fait qu'une brève apparition hier matin.

Donc merci Zon d'avoir pris le relais pour Jean, et d'avoir détecté ce résidu de Ligne en trop.

Comme quoi on fait une belle équipe sur XLD on devrait aller aux J.O. !!!

Bonne Journée à tous et toutes
@+Thierry

 

[Jean P]

Bonjour Thierry, Zon et le Forum

Encore une fois merci pour votre aide.

A) J'ai copié les deux procédures dans le même module que le usf.
B) A titre d'information, version Windows XP Professional et
version Excel 2003 SP1

Mais je crois que je ne suis pas vraiement doué pour le VBA car j'ai encore un message d'erreur: Erreur d'exécution 1004 L'accès par programme au projet Visual Basic n'est pas fiable.

Quand je clique sur le bouton débogage, il surligne en jaune la ligne suivante: With Wbk.VBProject

Et je vois que la variable VBC me donne la valeur Nothing.
La variable NomC me donne : juillet Historique Cartierville.xls

Malheureusement, mes faibles connaissances attendent vos lumières.

Encore une fois merci.


Jean P.

 

[@+Thierry]

Bonsoir Jean, Zon, le Forum

Ah tu as bien fait de préciser la version XP, en effet il faut avant de lancer la macro cocher une option nouvelle pour XP dès qu'on touche aux Modules...

&nbsp;&nbsp;&nbsp;&nbsp;Dans les Menus d'Excel
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;=> Outils
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;=> Macro
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;=> Sécurité
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;=> Second Onglet (je n'ai pas XP sous les yeux)
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;(Dans le Style Source Fiable)
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;=> Cocher l'Option "Faire Confiance Au Projet (un Truc Comme ça...)

Bonne Soirée
@+Thierry

 

[Zon]

Salut,

Bon pas trouvé mieux que du Sendkeys(ici version FR, Thierry nous donnera certainement la version US) mais on peut cocher cette option par VBA. Macrokiller devient récursive quand l'option n'est pas cochée. Jean P le reste du code n'est pas à changer.

Sub MacroKiller(NomC$)
Dim VBC As Object, Wbk As Workbook
On Error GoTo Errr 'permet d'éviter le messaged 'erreur, on va à la fin
Set Wbk = Workbooks(NomC)
With Wbk.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
Errr:
If Err = 1004 Then SendKeys "%om2d%r~", True: MacroKiller NomC
'Pour Info
'err=9 c'est que le classeur n'est pas ouvert ou le nom n'est pas bon

End Sub

A+++

 

[@+Thierry]

Bonjour Zon, Jean, le Forum

Je bois le café là, mais je penserai à regarder au bureau dans la journée pour la traduction US.

Bonne journée à tous et toutes
@+Thierry

 

[@+Thierry]

Bonjour Zon, Jean, le Forum

Comme promis j'ai regardé sur XP en version US, le SendKey donne ceci :

Sub TrustAccessToVisualBasicProject_US()
SendKeys "%tmstv%v~", True
End Sub

Par contre chez moi c'est une otion cochée une fois pour toute, mais j'ai aussi des items dans les Trusted Source, ce doit être pour ceci...

Bon Appétit
@+Thierry

 

[Jean P]

Bonjour thierry, Zon et le Forum

Je vous remercie pour tous vos conseils.
Le problème est résolu grâce à votre aide.

J'ai effectué le règlage dans Excel, la case a cocher pour faire confiance au projet Visual Basic.

Encore une fois merci.

Jean P.