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.
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).
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".
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
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
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
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.
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
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
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.
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.
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
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.