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

 

[Benjy]

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

Ah non j'ai oublié un détail... Les *.pdf.

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*", "*.pdf")
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

Case Arr(2)

End Sub

Quel code inscrire après la ligne
Case Arr(2) pou réaliser la même chose avec les pdf ?

 

[kiki29]

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

Salut,comme déjà précisé plus haut voir avec ShellExecute

 

[Benjy]

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

Salut,comme déjà précisé plus haut voir avec ShellExecute

Re bonjour,

J'ai réussi avec ce code :

Option Explicit

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
    (ByVal lpClassName As String, ByVal lpWindowName As String) As Long

Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
    (ByVal hWnd As Long, ByVal lpOperation As String, ByVal lpFile As String _
    , ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long

et

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*", "*.pdf")
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)
Wk.PrintOut
Wk.Close False
Fichier = Dir()
Loop
Set Wk = Nothing


Case Arr(2)
Dim x As Long
x = FindWindow("XLMAIN", Application.Caption)
ShellExecute x, "print", Chemin & Fichier, "", "", 1
End Select
Next
End Sub

Merci pour votre aide.
Cordialement,

Ben

 

[jeanchrist0147]

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

Chemin = "Z:\protocole\"

Bonjour,

Je reviens sur le sujet.
Est-il possible de définir une cellule , par exemple D10, qui définirait le chemin voulu? En fait Z:\protocole\ apparaitrait dans une cellule et non en dur dans la macro.

Merci d'avance pour votre aide.

Cdt

 

[Pierrot93]

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

Bonjour,

Est-il possible de définir une cellule , par exemple D10, qui définirait le chemin voulu? En fait Z:\protocole\ apparaitrait dans une cellule et non en dur dans la macro.

oui, tu peux faire ainsi :

Chemin = Range("A1").Value

bonne journée
@+

 

[jeanchrist0147]

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

Super
Merci beaucoup.
@+