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

LBi

XLDnaute Junior
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
 

Victor21

XLDnaute Barbatruc
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.
 

LBi

XLDnaute Junior
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
 
Dernière édition:

job75

XLDnaute Barbatruc
Re, salut Patrick, Lone-wolf,

Voyez les fichiers (zippés) joints et cette macro :
Code:
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+
 

Pièces jointes

  • Supprimer code(1).zip
    65.7 KB · Affichages: 35

LBi

XLDnaute Junior
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
 
Dernière édition:

job75

XLDnaute Barbatruc
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 :
Code:
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.
 

Pièces jointes

  • Supprimer code(2).zip
    71 KB · Affichages: 30
Dernière édition:

Staple1600

XLDnaute Barbatruc
Re

Une suggestion en passant (à l'attention du demandeur)
Pourquoi ne pas simplement créer une petite macrodans PERSONAL.xlsb ?
VB:
Sub Ouvrir
Application.Workbooks.Open "D:\Biologie\Tableau biologique.xlsm"
End sub
qui serait appelé dans Enregistre
VB:
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 ;)
VB:
Sub Ouvrir
'Application.Workbooks.Open "D:\Biologie\Tableau biologique.xlsm"
End sub

Et là le temps de traitement n'est plus un problème ;)
 
Dernière édition:

Discussions similaires

Réponses
13
Affichages
241
Réponses
6
Affichages
362

Statistiques des forums

Discussions
311 712
Messages
2 081 802
Membres
101 819
dernier inscrit
lukumubarth