Sub Impression()
Dim WApp As Object
Dim doc, nb
Dim cel As Range
Dim Chemin As String
Dim nbpagessuivante As Integer
Application.WindowState = xlMinimized
Set WApp = CreateObject("Word.Application")
WApp.Visible = True
Chemin = "L:\ORGANISATION\Documents originaux\Lsf présentation\"
'Tri Tableau
Range("A4:C15").Select
ActiveWorkbook.Worksheets("Feuil1").AutoFilter.Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Feuil1").AutoFilter.Sort.SortFields.Add Key:=Range _
("C4"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("Feuil1").AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
ActiveWorkbook.Worksheets("Feuil1").AutoFilter.Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Feuil1").AutoFilter.Sort.SortFields.Add Key:=Range _
("B4"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("Feuil1").AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
'Sélection des impressions
With Sheets("Feuil1")
For Each cel In .Range("b5:b15")
x = x + 1
If cel >= 1 Then
doc = Chemin & "\" & cel.Offset(0, -1) & ".doc"
'Ouvre le document
WApp.Documents.Open (doc)
nb = cel
'Ajoute le numéro de page
nbpagessuivante = NbPages + x
With WApp.ActiveDocument.Sections(1)
.Footers(wdHeaderFooterPrimary).Range.Paragraphs. _
Alignment = wdAlignParagraphCenter
.Footers(wdHeaderFooterPrimary).Range.Text = "Page " & nbpagessuivante
End With
t = Timer + 1.3: Do Until Timer > t: DoEvents: Loop
Else
Exit For
End If
'Imprime
WApp.ActiveDocument.PrintOut Copies:=nb
'Ferme le document actif
WApp.ActiveDocument.Close
Next cel
End With
WApp.Quit
'Tri Tableau
Range("A4:C15").Select
ActiveWorkbook.Worksheets("Feuil1").AutoFilter.Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Feuil1").AutoFilter.Sort.SortFields.Add Key:=Range _
("C4"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("Feuil1").AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Application.WindowState = xlNormal
End Sub