Ordre des onglets pour conversion en PDF

[Essart]

Bonjour à tous,

par vba, je veux transformer en pdf, sous 2007, certaines pages seulement d''un fichier et dans l'ordre de sélection.

Si j'arrive bien à sélectionner en 1er la page de garde,
en 2ème la page synthèse
puis en 3ème toutes les pages à onglet de couleur bleu,
puis en 4ème toutes les pages à onglet de couleur jaune,
puis en 5ème toutes les pages à onglet de couleur saumon
une MsgBox me confirme que l'ordre est bon ...
quand je fais par la macro SaveAs ...pdf,
les feuilles n'arrivent pas dans le bon ordre !
-> la page de garde se retrouve au milieu du pdf et la page synthèse encore plus loin

Je ne sais pas comment faire ...?


S'agit-il d'un bog ou d'une limite d'excel sous 2007 ?

Merci pour votre aide


Sub impression_pdf()

Dim Sh As Worksheet

Sheets("Page de garde").Select
' toujours en première feuille
Sheets("Synthèse").Select Replace:=False
' toujours en deuxième feuille

For Each Sh In ActiveWorkbook.Sheets
' pour feuille "bleue claire"
If Sh.Tab.ColorIndex = 34 Then Sh.Select Replace:=False
Next

For Each Sh In ActiveWorkbook.Sheets
' pour feuille "jaune claire"
If Sh.Tab.ColorIndex = 36 Then Sh.Select Replace:=False
Next

For Each Sh In ActiveWorkbook.Sheets
' pour feuille "saumon"
If Sh.Tab.ColorIndex = 22 Then Sh.Select Replace:=False
Next

Sheets("Page de garde").Activate

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
ThisWorkbook.Path & "\" & ThisWorkbook.Name & ".pdf", Quality:= _
xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=True
Sheets("Synthèse").Activate
Range("A1").Select
End Sub

 

[_Thierry]

Re : Ordre des onglets pour conversion en PDF

Bonsoir Essart, le Forum

En fait même en regardant simplement l'Aperçu avant impression, les Feuilles sélectionnées arrivent dans l'ordre de leur index, et pas dans l'ordre où tu les as sélectionnées... Donc je ne pense pas que ce soit un bug, juste que ce n'est pas prévu comme ca...

A mon idée faudrait arriver à les ré-indexer "provisoirement" en stockant au préalable leur emplacement d'origine ... Ce ne va pas être si facile mais réalisable je crois... Cra Index est en read only, on ne peut jouer qu'avec Move...

Un exemple :
For Each Sh In ActiveWorkbook.Sheets
' pour feuille "bleue claire"
If Sh.Tab.ColorIndex = 34 Then
Sh.Select Replace:=False
Sh.Move before:=Worksheets(1)
MsgBox Sh.Index
End If
Next

Pour remettre en place après tu vas "t'amuser"... ou alors tu fermes sans sauver (par macro c'est possible)

Bon Courage
@+Thierry

 

[Essart]

Re : Ordre des onglets pour conversion en PDF

Bonjour Thierry,

Merci beaucoup pour l'explication et la piste ...

je vais creuser cela demain
et te tiendrais au courant du suivi...

merci pour ton aide
et bonne nuit !

Essart

 

[mapomme]

Re : Ordre des onglets pour conversion en PDF

Bonjour Essart, _Thierry,

Un essai d'après l'idée de _Thierry, en ayant ajouté un tri sur le nom des onglets au sein de chaque groupe d'onglets de même couleur.

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

 

[Essart]

Re : Ordre des onglets pour conversion en PDF

Bonjour Thierry,
bonjour mapomme,

Merci de vous être penché sur mon problème qui me semblait très épineux....

'ai pu adapter l'approche de thierry et cela fonctionne, même si les onglets se retrouvent dans un autre ordre.

La solution proposée par mapomme est très classe, quoique pas si simple.
Elle fonctionne bien sur le petit fichier que j'avais joint;
et dans le fichier complet aussi

Superbe !

Merci à tous les deux pour votre aide

Essart

 

[_Thierry]

Re : Ordre des onglets pour conversion en PDF

Bonsoir Essart, Mapomme; le Forum

wow c'est vrai que MaPomme est allé bien loin dans le schmilbick, moi j'avais peur de me lancer dans un tel truc !

Bravo !

@+Thierry