Sub impression_pdf()
Dim Sh As Worksheet, k As Long, k1 As Long, k2 As Long
Dim InitFeuil(), FF(), i As Long, aux, Ech As Boolean
Application.ScreenUpdating = False
ReDim InitFeuil(1 To Sheets.Count): ReDim FF(1 To Sheets.Count)
'stockage des noms de feuilles dans l'ordre initial
For i = 1 To Sheets.Count: InitFeuil(i) = Sheets(i).Name: Next i
On Error GoTo impression_pdf_Err1
'1ère et 2eme feuilles
FF(1) = Sheets("Page de garde").Name: FF(2) = Sheets("Synthèse").Name
'recherche des onglets de couleur bleu clair
k1 = 2: k2 = k1
For Each Sh In ActiveWorkbook.Sheets
' pour feuille "bleu clair"
If Sh.Tab.ColorIndex = 34 Then
'bleu clair -> incrémentation borne sup du tableau
'Stockage du nom de la feuille
k2 = k2 + 1: FF(k2) = Sh.Name
End If
Next
'Tri des noms "Bleu clair" par ordre alpha.
Do
'indicateur si un échange s'est produit ou pas
'borne inf du tri -> k1 +1
'borne sup du tri k2-1 (car k2-1+1 = k2 = borne sup)
Ech = False
For i = k1 + 1 To k2 - 1
If StrComp(FF(i), FF(i + 1), vbTextCompare) = 1 Then
aux = FF(i): FF(i) = FF(i + 1): FF(i + 1) = aux: Ech = True
End If
Next i
Loop Until Not Ech
'idem jaune clair
k1 = k2: k2 = k1
For Each Sh In ActiveWorkbook.Sheets
' pour feuille "jaune clair"
If Sh.Tab.ColorIndex = 36 Then
k2 = k2 + 1: FF(k2) = Sh.Name
End If
Next
'Tri
Do
Ech = False
For i = k1 + 1 To k2 - 1
If StrComp(FF(i), FF(i + 1), vbTextCompare) = 1 Then
aux = FF(i): FF(i) = FF(i + 1): FF(i + 1) = aux: Ech = True
End If
Next i
Loop Until Not Ech
'idem saumon
k1 = k2: k2 = k1
For Each Sh In ActiveWorkbook.Sheets
' pour feuille "saumon"
If Sh.Tab.ColorIndex = 22 Then
k2 = k2 + 1: FF(k2) = Sh.Name
End If
Next
'Tri
Do
Ech = False
For i = k1 + 1 To k2 - 1
If StrComp(FF(i), FF(i + 1), vbTextCompare) = 1 Then
aux = FF(i): FF(i) = FF(i + 1): FF(i + 1) = aux: Ech = True
End If
Next i
Loop Until Not Ech
'déplacement des feuilles concernées dans le bon ordre
For i = k2 To 1 Step -1
Sheets(FF(i)).Move before:=Sheets(1)
Next i
'selection de la 1ière feuille
Sheets(1).Select
'selection/ajout des suivantes
For i = 2 To k2: Sheets(FF(i)).Select Replace:=False: Next i
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
ThisWorkbook.Path & "\" & ThisWorkbook.Name & ".pdf", Quality:= _
xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=True
'on replace les feuilles dans l'ordre initial
For i = Sheets.Count To 1 Step -1
Sheets(InitFeuil(i)).Move before:=Sheets(1):
Next i
Sheets("Synthèse").Activate: Range("A1").Select
Application.ScreenUpdating = True
Exit Sub
'En cas d'erreur
impression_pdf_Err1:
'En cas d'erreur, on replace les feuilles dans l'ordre initial
For i = Sheets.Count To 1 Step -1
Sheets(InitFeuil(i)).Move before:=Sheets(1)
Next i
Sheets("Synthèse").Activate: Range("A1").Select
'On indique l'erreur
MsgBox "Une erreur est survenue:" & vbLf & vbLf & Err.Description
Application.ScreenUpdating = True
End Sub