XL 2019 Ouverture et fermeture de plusieurs fichiers ds un dossier

farid

XLDnaute Occasionnel
Bonjour,
Je vais essayer de m'expliquer et d'être précis sur ma demande. J'ai parcouru sur le web et trouvé certaines solutions, mais qui ne me conviennent pas, je m'explique.
À partir d'un fichier GMAO qui se trouve dans un dossier qui s'appelle "méthode" pouvoir lors d'un clic sur un bouton IMPRIME ouvrir tous les fichiers qui se trouvent dans le dossier "Méthode\Archive\Archive-2022" un par un, c'est-à-dire on ouvre le fichier puis on appelle une macro (que j'ai déjà et fonctionne très bien cette macro imprime la feuille de l'onglet du mois en cours et se referme automatiquement). Et ouvre le deuxième fichier dans le dossier ainsi de suite en appelant la même macro qui se trouve dans chacun de ces fichiers. Le but, à partir de la macro qui se trouvera dans le fichier GMAO, de lancer la phase d'imprimer de tous les fichiers pour le mois en cours.

Dans l'exemple du fichier en PJ on a dans le dossier Méthode un fichier GMAO et un dossier "Archive" et ds ce dossier archive il y a un dossier "Archive-2022" ou se trouve tous les fichiers (ds mon vrai dossier, il y a plus de 200 fichiers). Lorsqu'on clique sur le fichier GMAO on tombe du tableau avec des fiches ds la colonne A, lorsqu'on double clic sur le n°1 on ouvre un fichier et si je clique sur le bouton, on ouvre un userform qui me permet de choisir les mois et en cliquant sur le bouton et imprime le mois en cours selon la VBA,et ferme automatiquement le fichier 1, d'où ma demande, éviter d'ouvrir chaque fichier et de cliquer sur le bouton principal et sur le bouton imprime.

j'espère que je me suis compris
merci par avance
 

Pièces jointes

  • Méthode (2).zip
    919.5 KB · Affichages: 8

farid

XLDnaute Occasionnel
Bonjour,

Ta macro est introuvable dans ton fichier. Pour moi ta demande n'est pas clair. Ce qui évident pour toi ne l'est pour ceux qui tentent d'aider.

A+
Bonjour cp4
merci de se pencher sur ma demande.
Désolé si je ne suis pas clair sur ma demande.
Actuellement, lorsque je souhaite imprimer plusieurs fichiers en partant du tableau GMAO et que je clique sur les numéros dans la colonne A, cela ouvre le fichier qui se trouve dans Archive\Archive 2022. À partir de ce fichier lorsque je clique sur le bouton, cela ouvre l'uerform 1 et à partir de cette userform lorsque je clique sur le bouton imprime, cela imprime le fichier si ce dernier a été créé dans l'uerform et ensuite la feuille se referme tout seul et je reviens sur le tableau GMAO, par contre si sur la feuille 1 la case avril n'est pas cochée et crée et que je clique sur le bouton imprime, j'ai un message qui dit que le fichier n'existe pas et se referme tout seul et je reviens sur la feuille GMAO. Dans l'exemple que j'ai transmis, le classeur 1 le mois d'avril n'est pas créé et par contre dans le classeur 2, le mois d'avril est créé. Je viens d'essayé et cela fonctionne, voila pour l'initial.
Ma demande consiste si cela est possible et m'éviter à chaque fois de double-clic sur les numéros de la colonne A du classeur GMAO (dans ma fiche originale, il y a 270 classeurs)ensuite le classeur s'ouvre et de cliquer sur le bouton imprimer de l'userform1. Je souhaite qu'à partir du classeur GMAO cliquer sur le bouton imprimer et que cela ouvre un par un les fichiers qui se trouve dans le dossier Archive :\Archive 2022, ensuite on appelle la macro "Impression" ensuite se referme seul et ouvrir le classeur 2 /3/4/5/....... et ainsi de suite et toujours en appelant la macro "impression".

Par avance merci
 

cp4

XLDnaute Barbatruc
Mets ce code dans un module standard du fichier GMAO et exécute la macro "TestListeFichiers".
J'ai mis un msgbox pour signaler que le fichier est ouvert, tu mets ton code juste en dessous et tu neutralises cette msgbox. Lien de la source du code adapté à ton cas --->Lien

A+
VB:
Option Explicit
Sub TestListeFichiers()
    Dim Dossier As String
    'Définit le répertoire pour débuter la recherche de fichiers.
    '(Attention à ne pas indiquer un répertoire qu contient trop de sous-dossiers ou de
    'fichiers, sinon le temps de traitement va être très long).
    Dossier = ThisWorkbook.Path 'chemin à adapter
 
    'Appelle la procédure de recherche des fichiers
    ListeFichiers Dossier
        MsgBox "Terminé"
End Sub
 
Sub ListeFichiers(Repertoire As String)
    Dim Fso As Object,SourceFolder As Object,SubFolder As Object,FileItem As Object
 
    Set Fso = CreateObject("Scripting.FileSystemObject")
    Set SourceFolder = Fso.GetFolder(Repertoire)

    'Boucle sur tous les fichiers du répertoire
    For Each FileItem In SourceFolder.Files

If FileItem.Name <> ThisWorkbook.Name And FileItem.Name <> "~$" & ThisWorkbook.Name Then
Workbooks.Open SourceFolder & "/" & FileItem.Name 'ouverture du fichier
'--------------
MsgBox "fichier ouvert" 'msgbox à neutraliser
'Mettre ici ton code pour imprimer
'----------------------
Application.DisplayAlerts = False
ActiveWorkbook.Close 'fermeture'
Application.DisplayAlerts = True

End If

Next FileItem
 
    '--- Appel récursif pour lister les fichier dans les sous-répertoires ---.
    For Each SubFolder In SourceFolder.subfolders
        ListeFichiers SubFolder.Path
    Next SubFolder
End Sub

A+
 

farid

XLDnaute Occasionnel
Mets ce code dans un module standard du fichier GMAO et exécute la macro "TestListeFichiers".
J'ai mis un msgbox pour signaler que le fichier est ouvert, tu mets ton code juste en dessous et tu neutralises cette msgbox. Lien de la source du code adapté à ton cas --->Lien

A+
VB:
Option Explicit
Sub TestListeFichiers()
    Dim Dossier As String
    'Définit le répertoire pour débuter la recherche de fichiers.
    '(Attention à ne pas indiquer un répertoire qu contient trop de sous-dossiers ou de
    'fichiers, sinon le temps de traitement va être très long).
    Dossier = ThisWorkbook.Path 'chemin à adapter
 
    'Appelle la procédure de recherche des fichiers
    ListeFichiers Dossier
        MsgBox "Terminé"
End Sub
 
Sub ListeFichiers(Repertoire As String)
    Dim Fso As Object,SourceFolder As Object,SubFolder As Object,FileItem As Object
 
    Set Fso = CreateObject("Scripting.FileSystemObject")
    Set SourceFolder = Fso.GetFolder(Repertoire)

    'Boucle sur tous les fichiers du répertoire
    For Each FileItem In SourceFolder.Files

If FileItem.Name <> ThisWorkbook.Name And FileItem.Name <> "~$" & ThisWorkbook.Name Then
Workbooks.Open SourceFolder & "/" & FileItem.Name 'ouverture du fichier
'--------------
MsgBox "fichier ouvert" 'msgbox à neutraliser
'Mettre ici ton code pour imprimer
'----------------------
Application.DisplayAlerts = False
ActiveWorkbook.Close 'fermeture'
Application.DisplayAlerts = True

End If

Next FileItem
 
    '--- Appel récursif pour lister les fichier dans les sous-répertoires ---.
    For Each SubFolder In SourceFolder.subfolders
        ListeFichiers SubFolder.Path
    Next SubFolder
End Sub

A+
 

farid

XLDnaute Occasionnel
Mets ce code dans un module standard du fichier GMAO et exécute la macro "TestListeFichiers".
J'ai mis un msgbox pour signaler que le fichier est ouvert, tu mets ton code juste en dessous et tu neutralises cette msgbox. Lien de la source du code adapté à ton cas --->Lien

A+
VB:
Option Explicit
Sub TestListeFichiers()
    Dim Dossier As String
    'Définit le répertoire pour débuter la recherche de fichiers.
    '(Attention à ne pas indiquer un répertoire qu contient trop de sous-dossiers ou de
    'fichiers, sinon le temps de traitement va être très long).
    Dossier = ThisWorkbook.Path 'chemin à adapter
 
    'Appelle la procédure de recherche des fichiers
    ListeFichiers Dossier
        MsgBox "Terminé"
End Sub
 
Sub ListeFichiers(Repertoire As String)
    Dim Fso As Object,SourceFolder As Object,SubFolder As Object,FileItem As Object
 
    Set Fso = CreateObject("Scripting.FileSystemObject")
    Set SourceFolder = Fso.GetFolder(Repertoire)

    'Boucle sur tous les fichiers du répertoire
    For Each FileItem In SourceFolder.Files

If FileItem.Name <> ThisWorkbook.Name And FileItem.Name <> "~$" & ThisWorkbook.Name Then
Workbooks.Open SourceFolder & "/" & FileItem.Name 'ouverture du fichier
'--------------
MsgBox "fichier ouvert" 'msgbox à neutraliser
'Mettre ici ton code pour imprimer
'----------------------
Application.DisplayAlerts = False
ActiveWorkbook.Close 'fermeture'
Application.DisplayAlerts = True

End If

Next FileItem
 
    '--- Appel récursif pour lister les fichier dans les sous-répertoires ---.
    For Each SubFolder In SourceFolder.subfolders
        ListeFichiers SubFolder.Path
    Next SubFolder
End Sub

A+
Bonjour cp4

Merci infiniment pour ta solution qui fonctionne très bien en suivant tes instructions. Je vais être embêtant et profiter de tes connaissances, je m’explique.

Dans l’archive « Méthode 1 », lorsqu’on ouvre GMAO et un clic sur le bouton « imprimante’ ta formule fonctionne très bien, je l’ai essayé sur plusieurs fichiers. Dans notre cas il y 2 fichiers et dans ces fichiers il y a un module « Impression » pour lequel j’ai inhibé la ligne « Call enregistrement ».

Dans l’archive « Méthode 2 », lorsque je clique sur le fichier GMAO et que je clique sur le bouton imprimant, cela fonctionne pour le premier fichier n°1 mais pas le n° 2 et tu remarqueras sur le tableau GMAO que la cellule avril est passée en violet, un indicateur qui m’est nécessaire dans mon projet. Sur ce second exemple, j’ai activé la ligne Call enregistrement dans le module « Impression » qui active la macro qui se trouve DS le module 2 et j’ai vraiment besoin de ce module.

Donc la question est ce possible de profiter de ta formule que tu m’as transmis avec la fonction call enregistrement dans le module "impression"qui permet de conserver mon indicateur et ce n’est pas le seul indicateur.

J’espère que ma demande n’est pas une usine à gaz.

Par avance merci pour ton implication à mon projet.
 

Pièces jointes

  • Méthode 1.zip
    906.1 KB · Affichages: 3
  • Méthode 2.zip
    923 KB · Affichages: 2

cp4

XLDnaute Barbatruc
Bonjour,

Lorsque ma macro ouvre successivement tes classeurs, ces derniers s'ouvrent sur la feuille active lors de l'enregistrement à la fermeture. Or, je viens de faire un essai avec ton fichier (Archie1), le fichier 1.xlsm s'ouvre sur la feuille "Résultat"; dans ton code ci-dessous
VB:
Sub Impression()
Nomfeuille = "" & Range("a3") & Year(Now()) & " " & Month(Now())
If FeuilleExiste(Nomfeuille) = True Then
    Worksheets(Nomfeuille).PrintOut
    Range("F" & 19 + Month(Now())) = "Fiche imprimée"
    Sheets(Nomfeuille).Range("AF1") = "Fiche imprimée"
    Sheets(Nomfeuille).Range("Ae1") = "3"
    'Call enregistrement
Else
       'CreateObject("WScript.Shell").Popup ("La feuille " & Nomfeuille & " n'existe pas."), 1
    'MsgBox ("La feuille " & Nomfeuille & " n'existe pas.")
     'Call enregistrement
End If
End Sub
D'après ton code le nom de la feuille est constitué de la cellule A3 suivi de l'année et du mois. Tu risques d'avoir des problèmes comme expliquer plus haut.
Si je comprends bien tu voudrais imprimer une feuille en vérifiant si elle existe?

Bonne journée.

ps: j'ouvrirai ta 2me archive plus tard, occupé.

edit: tu affectes 2 de suite le chemin 'dossier'
VB:
Sub TestListeFichiers()
Dim Dossier As String
   
Dossier = ThisWorkbook.Path '
Dossier = ThisWorkbook.Path & "\.\Archive\Archive-2022" 'à supprimer
   
ListeFichiers Dossier
MsgBox "Terminé"
End Sub
 
Dernière édition:

cp4

XLDnaute Barbatruc
J'ai pris sur mon temps pour réparer un truc pour tester archive2.
Tes codes ne sont pas très rigoureux. En effet, certaines fois tu écris par exemple:
Sheets("Feuille_modèle").Range("b3"), là on comprend que c'es la cellule b3 de la feuille Feuille_modèle
Par contre, Range("B3:dx3").Copy, on copie les cellules de quelle feuille. Par rigoureux et qui pourrait causer des plantages.
Ensuite, tu utilises Select et Selection, ils ralentissent ton code pour rien.
au lieu d'écrire
VB:
Range("AF1").Select
ActiveCell.FormulaR1C1 = "Fiche imprimée"
Selection.Font.Bold = True
Selection.HorizontalAlignment = xlCenter
il est préférable d'écrire
Code:
With Range("AF1")
.FormulaR1C1 = "Fiche imprimée"
.Font.Bold = True
.HorizontalAlignment = xlCenter
End with

Pour ton problème Archive2, je n'ai pas encore trouvé. Je dois m'arrêter car je dois absolue réparer un truc.
Il y un truc qui fermer le fichier GMAO prématurément via un code dans fichier 1.xlsm et 2.xlsm.
Ces 2 fichiers doivent s'enregistrer et se fermer depuis ma macro corrigée ci-dessous.
Code:
Option Explicit
Sub TestListeFichiers()
Dim Dossier As String
    
Dossier = ThisWorkbook.Path '
ListeFichiers Dossier
ThisWorkbook.Save 'enregistre les modifications de GMAO
MsgBox "Terminé"
End Sub

Sub ListeFichiers(Repertoire As String)
    Dim Fso As Object, SourceFolder As Object, SubFolder As Object, FileItem As Object

    Set Fso = CreateObject("Scripting.FileSystemObject")
    Set SourceFolder = Fso.GetFolder(Repertoire)

    For Each FileItem In SourceFolder.Files

        If FileItem.Name <> ThisWorkbook.Name And FileItem.Name <> "~$" & ThisWorkbook.Name Then
            Workbooks.Open SourceFolder & "/" & FileItem.Name
            '--------------

            Application.Run "'" & FileItem.Name & "'!Impression"

            '----------------------
            Application.DisplayAlerts = False
            With ActiveWorkbook
                .Save: .Close    'Enregistrement et fermeture des fichiers Archive
            End With
            Application.DisplayAlerts = True
        End If
    Next FileItem

    For Each SubFolder In SourceFolder.subfolders
        ListeFichiers SubFolder.Path
    Next SubFolder
End Sub
Pour le reste, suit le déroulement pas à pas (touche F8) pour déceler le bout de code en cause.

Bonne continuation.
 

farid

XLDnaute Occasionnel
Mon ultime intervention avant de me faire disputer ......
Comment te le dire ! Qu'y a-t-il au-dessus de nickel ? Je l'ai intégré dans mon tableau source, pure merveille et tu n'as pas idée à quel point (pour info. J'ai dû mettre ce chemin "Dossier = ThisWorkbook.Path & "\.\Archive\Archive-2022" " car sur mon fichier source, il y a plusieurs dossiers qui représentent une année)merci infiniment et mes excuses auprès de madame, j'espère qu'elle ne tu n'as pas disputé, c'était pour la bonne cause 😁😁😁. Si tu passes en Auvergne au Panoramique du Puy-de-Dôme, demande Farid, le responsable maintenance, plaisir de t'offrir un tour de train au sommet.
 

cp4

XLDnaute Barbatruc
Si tu passes en Auvergne au Panoramique du Puy-de-Dôme, demande Farid, le responsable maintenance, plaisir de t'offrir un tour de train au sommet.
Bonjour Farid,
Content que tu aies trouvé ton bonheur. Merci pour l'invitation si l'occasion se présente de venir en Auvergne.
Un dernier conseil, évite les 'select' et 'selection' car ça ralenti inutilement l’exécution du code.
Je n'ai pas pu réparer le robot hier mais j'ai commandé la pièce. Donc pas de dispute:D:cool:

Bonne journée.

ps: n'oublie pas de pointer le message (à droite flèches haut/bas) de la solution, ça facilitera la recherche aux membres du forum.
 

Discussions similaires

  • Résolu(e)
Microsoft 365 requête Dossier
Réponses
6
Affichages
497

Statistiques des forums

Discussions
315 059
Messages
2 115 816
Membres
112 552
dernier inscrit
nenette223