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
> 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 ?
WordDoc.PrintPreview
WordDoc.Print
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
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