(RESOLU) Supprimer des lignes d'une macro dans 400 fichiers Excel

[LBi]

Bonjour,
J'aimerais automatiser la suppression d'une ligne de code à l'intérieure d'une macro "Enregistre" dans plusieurs fichiers excel qui se trouvent dans un dossier.
Merci de votre aide

 

[job75]

Bonjour LBi,

Pour que ce soit facile il faut que la macro soit dans un même module, par exemple Module1, pour tous les fichiers.

C'est le cas ?

Et quel est le texte du code à supprimer ?

A+

 

[Victor21]

Bonjour, LBi.

Merci de joindre les 400 fichiers après les avoir anonymisés.
(A défaut, quelques explications supplémentaires et la macro en question pourraient aider un éventuel intervenant à vous aider)
Edit : Bonjour, job75.

 

[Lone-wolf]

Bonsoir Gerard, Patrick, LBi 🙂

@Victor21 :

Merci de joindre les 400 fichiers après les avoir anonymisés.

tu veux faire péter la baraque? 😵 😀. Tu me fait flipper! 😱😀

 

[LBi]

Option Explicit
Sub Enregistre()
Sheets("Nouvelle").Select
ActiveWorkbook.Sheets("Nouvelle").SaveAs Filename:="D:\Biologie\Termine\" & Range("F137")
Sheets("T1").Select
Application.Workbooks.Open "D:\Biologie\Tableau biologique.xlsm"
End Sub


C'est la ligne en rouge qui est à supprimer. ( elle me permettait d'ouvrir automatiquement un nouveau Tableau biologique lors de la saisie des 1300 prises de sang que j'avais à saisir, mais maintenant elle me gêne car elle ouvre un nouveau tableau à chaque sauvegarde.)
@job75
Les macros se trouvent tous dans le Module 2

 

[job75]

Re, salut Patrick, Lone-wolf,

Voyez les fichiers (zippés) joints et cette macro :

Sub SupprimerCode()
Dim chemin$, module$, macro$, texte$, fichier$, deb&, i&
chemin = ThisWorkbook.Path & "\" 'à adapter
module = "Module2" 'adaptable
macro = "Enregistre" 'adaptable
texte = "Application.Workbooks.Open ""D:\Biologie\Tableau biologique.xlsm""" 'adaptable
fichier = Dir(chemin & "*.xlsm") '1er fichier du dossier
Application.ScreenUpdating = False
On Error Resume Next 'si le module ou la macro n'existent pas
While fichier <> ""
    If fichier <> ThisWorkbook.Name Then
        With Workbooks.Open(chemin & fichier)
            With .VBProject.VBComponents(module).CodeModule
                deb = .ProcStartLine(macro, 0)
                For i = deb To deb + .ProcCountLines(macro, 0) - 1
                    If .Lines(i, 1) = texte Then .DeleteLines i, 1: Exit For
                Next
            End With
            .Close Not .Saved 'enregistrement et fermeture
        End With
    End If
    fichier = Dir 'fichier suivant
Wend
End Sub

Avec ce code tous les fichiers doivent être dans le même répertoire.

Il faudra patienter car le traitement de 400 fichiers prendra du temps...

Nota : pour que l'accès au VBAProject soit possible par macro il faut avoir coché l'option :

- sur Excel 2003 et versions antérieures Faire confiance au projet Visual Basic (menu Outils-Macro-Sécurité-Editeurs approuvés)

- sur Excel 2007 et versions suivantes Accès approuvé au modèle d'objet du projet VBA (onglet Fichier-Options-Centre de gestion de la confidentialité-Paramètres...-Paramètres des macros).

A+

 

[LBi]

Bonsoir,
La macro fonctionne avec les fichiers qui sont dans votre ZIP.
Mais pas sur mes fichiers.

J'ai collé ma macro dans le fichier à traiter 3 et cela ne fonctionne pas non plus.

Dans la macro du début de mon post, j'avais omis les lignes avec un guillemet pensant que c'était inutile, mais peut être que le problème vient de là ?
Donc voilà la macro tel que dans les 400 fichiers.
Et tant qu à faire on peut aussi les supprimer pour nettoyer le code.

Option Explicit
Sub Enregistre()
Sheets("Nouvelle").Select 'selectionne onglet Nouvelle
ActiveWorkbook.Sheets("Nouvelle").SaveAs Filename:="D:\Biologie\Termine\" & Range("F137") 'chemin de sauvegarde lié à la cellule F137 de l'onglet Nouvelle
Sheets("T1").Select 'selectionne onglet T1
'ActiveWorkbook.Close False
'DoEvents
'Application.Quit
Application.Workbooks.Open "D:\Biologie\Tableau biologique.xlsm"
End Sub

 

[job75]

Bonjour LBi, le forum,

Il y avait peut-être des espaces devant le texte à supprimer, il faut alors les supprimer avec Trim.

Par ailleurs supprimer les lignes mises en commentaire ne pose pas de problème :

Sub SupprimerCode()
Dim chemin$, module$, macro$, texte$, fichier$, deb&, i As Variant
chemin = ThisWorkbook.Path & "\" 'à adapter
module = "Module2" 'adaptable
macro = "Enregistre" 'adaptable
texte = "Application.Workbooks.Open ""D:\Biologie\Tableau biologique.xlsm""" 'adaptable
fichier = Dir(chemin & "*.xlsm") '1er fichier du dossier
Application.ScreenUpdating = False
On Error Resume Next 'si le module ou la macro n'existent pas
While fichier <> ""
    If fichier <> ThisWorkbook.Name Then
        With Workbooks.Open(chemin & fichier)
            With .VBProject.VBComponents(module).CodeModule
                deb = .ProcStartLine(macro, 0)
                For i = deb + .ProcCountLines(macro, 0) - 1 To deb Step -1
                    If Trim(.Lines(i, 1)) = texte Then .DeleteLines i, 1
                    If Left(Trim(.Lines(i, 1)), 1) = "'" Then .DeleteLines i, 1 'lignes en commentaire
                Next
            End With
            .Close Not .Saved 'enregistrement et fermeture
        End With
    End If
    fichier = Dir 'fichier suivant
Wend
End Sub

Edit : déclaré i As Variant.

Fichier (2).

Bon week-end.

 

[job75]

Re,

J'ai constaté que si la macro "Enregistre" n'est pas trouvée la boucle For/Next boucle sans fin.

Pour l'éviter j'ai déclaré la variable i As Variant dans la macro précédente.

A+

 

[LBi]

Merci, tous les fichiers ont été traités.
Vraiment génial.

 

[job75]

Re,

Pour info j'ai créé 400 fichiers contenant uniquement la macro "Enregistre".

Chez moi sur Win 10 - Excel 2013 la macro s'exécute en 480 secondes.

A+

 

[Staple1600]

Bonjour job75

Re,
Pour info j'ai créé 400 fichiers contenant uniquement la macro "Enregistre".

Tu as créé manuellement 400 fichiers ? 😱

 

[job75]

Bonjour JM,

Tu as créé manuellement 400 fichiers ? 😱

Bien sûr avec une macro (une ligne de code avec SaveAs).

A+

 

[Staple1600]

Re

Une suggestion en passant (à l'attention du demandeur)
Pourquoi ne pas simplement créer une petite macrodans PERSONAL.xlsb ?

Sub Ouvrir
Application.Workbooks.Open "D:\Biologie\Tableau biologique.xlsm"
End sub

qui serait appelé dans Enregistre

Sub Enregistre()
Sheets("Nouvelle").Select
ActiveWorkbook.Sheets("Nouvelle").SaveAs Filename:="D:\Biologie\Termine\" & Range("F137")
Sheets("T1").Select
Ouvrir
End Sub

Ensuite quand Ouvrir devient ennuyeuse, il suffit d'ajouer un ' dans Ouvrir 😉

Sub Ouvrir
'Application.Workbooks.Open "D:\Biologie\Tableau biologique.xlsm"
End sub

Et là le temps de traitement n'est plus un problème 😉

 

[job75]

Re JM,

Bah que vas-tu chercher là ?

Il est évident que les 400 fichiers de LBi sont ce qu'ils sont et que la question est de les traiter !

A+