(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
 

job75

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

XLDnaute Barbatruc
Supporter XLD
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+
 

Fichiers joints

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.
 

Fichiers joints

Dernière édition:

job75

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

job75

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

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:

job75

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

Staple1600

XLDnaute Barbatruc
Re


@job75
Si j'ai bien compris le contexte (gestion de prises de sang)
Le 400 fichiers sont appelés à un jour être 500 ou plus
Rien n'empeche d'emettre telle ou telle suggestion pour modifier ou pas un mode opératoire.
Libre au demandeur de s'en inspirer ou pas.

Personnellement, plutôt que modifier N fichiers une fois qu'ils sont créés je préfère mettre en commentaire une macro stockée dans le classeur de macros complémentaires appelée par ces N fichiers.

[aparté]
je suis étonné (si il s'agit bien de cela ici) qu'un laboratoire d'analyes sanguines utilise Excel pour gérer ce genre d'analyses...
Il doit exister des logiciels métiers dédiés, non ?
[/aparté]
 

job75

XLDnaute Barbatruc
Re,

je suis étonné JM que tu méconnaisses ma réponse du post #15.

LBi a 400 fichiers sur les bras à modifier, point barre.

La question de savoir pourquoi et comment a été rédigée la macro "Enregistre" est sans aucun intérêt, le mal est fait.

Perso je ne l'aurai jamais créée, re-point barre.

A+
 

Staple1600

XLDnaute Barbatruc
Re

@job75
Je n'ai pas à commenter ta proposition ou ton code (je l'ai lu et compris)
C'est le demandeur qui posera ses questions le cas échéant.

Ma suggestion s'adressait au demandeur
(Et il en fera ce qu'il voudra)

Quant à savoir ce qui présente de l'interêt ou pas , c'est à chacun d'en décider, non ?

PS: Je ne vois pas où est le problème puisque ma "suggestion" est intervenue une fois que le post ait été passé en résolu par le demandeur...
 
Dernière édition:

LBi

XLDnaute Junior
Pour info, il s'agit d'un cabinet de rhumatologie et le nombre de tableaux biologiques (bien utiles pour suivre l’évolution biologique des patients) dépasse les 6000 que l'on rentrait avant manuellement...de 5 à 10 mn par résultat d’analyse médicale x 6000 tableaux x 3 résultats en moyenne par tableau = 1500 heures mini de saisie.
Les 400 tableaux correspondent aux dossiers en cours dans les 6 derniers mois. Maintenant, ils vont être créer au fur mesure des nouveaux patients.
En tous cas un grand merci aux personnes qui m'ont aidé dans l'élaboration de ce tableau biologique qui est vraiment au Top.
 

Créez un compte ou connectez vous pour répondre

Vous devez être membre afin de pouvoir répondre ici

Créer un compte

Créez un compte Excel Downloads. C'est simple!

Connexion

Vous avez déjà un compte? Connectez vous ici.

Haut Bas