Macro : Imprimer tous les fichiers d'un dossier

[Benjy]

Bonjour à tous,

Je cherche une macro pour imprimer tous les fichiers d'un dossier ( Z:\protocole\DATA\). ( Format Word, Excel et Pdf) Pas besoin de mise en page spécifique, juste les imprimer tels qu'ils sont à l'ouverture.

Merci d'avance,

Cordialement,

Ben

 

[tototiti2008]

Re : Macro : Imprimer tous les fichiers d'un dossier

Bonjour Benjy,

Je pense que ça devra passer par un ShellExecute :

Using ShellExecute from VB

Sais-tu parcourir tous les fichiers de ton dossier ?

 

[Benjy]

Re : Macro : Imprimer tous les fichiers d'un dossier

Bonjour,

Qu'entends tu par "parcourir tous les fichiers de ton dossier" ?
Cette interrogation doit vouloir dire non...

 

[kiki29]

Re : Macro : Imprimer tous les fichiers d'un dossier

Salut,pour ce qui est de parcourir un dossier et ses sous dossiers et lister les fichiers sur ce site Google

 

[tototiti2008]

Re : Macro : Imprimer tous les fichiers d'un dossier

Bonjour kiki,
Re,

ou bien là, sur l'excellent site de Jacques Boisgontier :
Gestion des fichiers et répertoires

 

[Benjy]

Re : Macro : Imprimer tous les fichiers d'un dossier

Re,

Hum sa reste flou. Je cherche juste à imprimer les fichiers d'un dossier.
ShellEx "C:\My Documents\Music\Brown Paper Bag.doc", , , , "print", Me.hWnd

Avec une boucle je suppose ?

 

[MJ13]

Re : Macro : Imprimer tous les fichiers d'un dossier

Bonjour à tous

Sinon, tu peux aller dans l'explorateur, choisir ton dossier, ctrl + a, click droit et Imprimer .

 

[Pierrot93]

Re : Macro : Imprimer tous les fichiers d'un dossier

Bonjour à tous,

bien vu Michel

 

[Benjy]

Re : Macro : Imprimer tous les fichiers d'un dossier

Re
Et par macro via un bouton ?
En gros j'ai tous les fichiers des dossiers suivant à imprimer :

Etude\courrier\Accuses reception\
Etude\courrier\courrier administratif
Etude\Plans archi
Etude\Plan lot assainissement
Etude\Plan lot chauffage
Etude\Plan lot electricité
Etude\Plan lot VMC
Etude\Plan lot sanitaire
Etude\Formulaires\materiaux
Etude\Formulaire\Metres
Etude\Formulaires\Offfre
Etude\Formulaires\Plis
Etude\Formulaires\Acompte

 

[MJ13]

Re : Macro : Imprimer tous les fichiers d'un dossier

Re, Bonjour Pierrot

Sinon une petite liste issu de l'aide sur Dir (F1) avant d'imprimer (voir avec Henry) .

Sub Rep()
' Affiche les noms dans C:\ représentant des dossiers.
MyPath = "C:\_ATCD\"    ' Définit le chemin d'accès.
MyName = dir(MyPath, vbDirectory)    ' Extrait la première entrée.
Do While MyName <> "*.xls"    ' Commence la boucle.
    ' Ignore le dossier courant et le dossier
    ' contenant le dossier courant.
    If MyName <> "." And MyName <> ".." Then
        ' Utilise une comparaison au niveau du bit pour
        ' vérifier que MyName est un dossier.
        If (GetAttr(MyPath & MyName) _
            And vbDirectory) = vbDirectory Then
            Debug.Print MyName    ' Affiche l'entrée uniquement si elle
        End If    ' représente un dossier.
    End If
    MyName = dir    ' Extrait l'entrée suivante.
Loop

End Sub

 

[Benjy]

Re : Macro : Imprimer tous les fichiers d'un dossier

Re,

J'ai trouvé cette macro :

> Sub Impression()
> Dim Fich As String, WordObj As Object, WordDoc As Object
>
> Fich = Dir(ThisWorkbook.Path & "\*.xlsm")
> Do While Fich <> ""
> Workbooks.Open ThisWorkbook.Path & "\" & Fich
> For Each sh In ActiveWorkbook.Sheets
> sh.PrintPreview
> Next sh
> ActiveWorkbook.Close False
> Fich = Dir
> Loop
> Set WordObj = CreateObject("Word.Application")
> WordObj.Visible = True
> 'Set WordObj = GetObject(, "Word.Application")
> Fich = Dir(ThisWorkbook.Path & "\*.docx")
> Do While Fich <> ""
> Set WordDoc = WordObj.documents.Open(ThisWorkbook.Path & "\" & Fich)
> WordDoc.PrintPreview
> WordDoc.Close
> Fich = Dir
> Loop
> Set WordDoc = Nothing
> Set WordObj = Nothing
> End Sub

Peut on la modifier pour qu'elle imprime directement les fichiers sans passer par l'apercu avant impression ?

 

[Pierrot93]

Re : Macro : Imprimer tous les fichiers d'un dossier

Re,

Peut on la modifier pour qu'elle imprime directement les fichiers sans passer par l'apercu avant impression ?

remplace :

WordDoc.PrintPreview

par :

WordDoc.Print

 

[Benjy]

Re : Macro : Imprimer tous les fichiers d'un dossier

Re,

Sub Impression()
Dim Fichier As String, WordObj As Object, WordDoc As Object
Dim Arr(), Chemin As String, Wk As Workbook, Elt As Variant

Chemin = "Z:\protocole\DATA\accuses reception\"

Arr = Array("*.docx", "*.xls*")

For Each Elt In Arr
Fichier = Dir(Chemin & "\" & Elt)
Select Case Elt
Case Arr(0)
Set WordObj = CreateObject("Word.Application")
WordObj.Visible = True
WordObj.Activate
Do While Fichier <> ""
Set WordDoc = WordObj.documents.Open(Chemin & Fichier)
WordDoc.Print
Do While WordObj.PrintPreview = True
DoEvents
Loop
WordDoc.Close False
Fichier = Dir()
Loop
WordObj.Quit
Set WordDoc = Nothing
Set WordObj = Nothing

Case Arr(1)
ThisWorkbook.Activate
Do While Fichier <> ""
Set Wk = Workbooks.Open(Chemin & Fichier)
For Each sh In Wk.Sheets
sh.Print
Next
Wk.Close False
Fichier = Dir()
Loop
Set Wk = Nothing
End Select
Next
End Sub

Hum cela ne marche pas. J'ai une erreur d'execution 438 sur la ligne WordDoc.Print
Je n'y connais pas grand chose en DO. Comment adapter la macro pour qu'elle imprime directement les fichiers word et Excel du dossier spécifié. Je n'ai pas besoin de faire d'aperçus ni même de voir ce que j'imprime. Juste les Imprimer...

 

[Pierrot93]

Re : Macro : Imprimer tous les fichiers d'un dossier

Re,

aarf, autant pour moi, c'est pas "Print" mais "PrintOut"... désolé....

 

[Benjy]

Re : Macro : Imprimer tous les fichiers d'un dossier

Effectivement j'avais corrigé.
Elle fonctionne je poste le code pour ceux qui seraient amener à effectuer une recherche :

Sub impression2()
Dim Fichier As String, WordObj As Object, WordDoc As Object
Dim Arr(), Chemin As String, Wk As Workbook, Elt As Variant
Chemin = "Z:\protocole\" & Sheets("Sommaire").Cells(28, 2).Value & "\Courrier\Accuses reception\"
Arr = Array("*.docx", "*.xls*")
For Each Elt In Arr
Fichier = Dir(Chemin & Elt)
Select Case Elt
Case Arr(0)
Set WordObj = CreateObject("Word.Application")
WordObj.Visible = True
WordObj.Activate
Do While Fichier <> ""
Set WordDoc = WordObj.documents.Open(Chemin & Fichier)
WordDoc.PrintOut
WordDoc.Close False
Fichier = Dir()
Loop
WordObj.Quit
Set WordDoc = Nothing
Set WordObj = Nothing

Case Arr(1)
ThisWorkbook.Activate
Do While Fichier <> ""
Set Wk = Workbooks.Open(Chemin & Fichier)
For Each sh In Wk.Sheets
sh.PrintOut
Next
Wk.Close False
Fichier = Dir()
Loop
Set Wk = Nothing
End Select
Next
End Sub

Merci à vous. Bonne après midi !