Optimisation des pages à imprimer

Bonjour à toutes et à tous,

je me permet de revenir vers tous afin d'essayer d'améliorer le temps d'impression.

La macro en elle même (boutton dans la feuille 1 "Check liste drucken" ) fonctionne très bien

(excel 2003 ...... non on ne rigole pas hein....) :

Sub MakroA()

Application.ScreenUpdating = False

Dim WS_Count As Integer

Dim I As Integer

' Set WS_Count equal to the number of worksheets in the active

' workbook.

WS_Count = ActiveWorkbook.Worksheets.Count

' Begin the loop.

For I = 2 To WS_Count

ActiveWorkbook.Worksheets(I).Activate

If Application.WorksheetFunction.IsText(Range("c13")) Then

ActiveWindow.SelectedSheets.PrintOut Copies:=1

End If

Next I

ActiveWorkbook.Worksheets(1).Activate

Application.ScreenUpdating = True

End Sub

Le soucis en pratique est que chaque impression de feuille (entre 15 et 30 feuilles) est lancée l'une après l'autre, ce qui avec mon actuelle imprimante (13 ppm en reseau delais d'impression de la première page 10 sec) peut prendre un certain temps (au pire 30 min au mieux 10min).

Existerait-il une solution afin de ne lancer qu'un seul ordre d'impression ?

En éspérant avoir été clair dans mes propos, merci par avance.

Ps: ce mess n'est pas Multi-poster

Bonjour

A tester en réel

Sub MakroA()
Dim Tablo()
Dim Ws As Worksheet
Dim Indice As Integer
'
' MakroA Makro
'

  For Each Ws In Sheets
    If Application.WorksheetFunction.IsText(Ws.Range("C13")) Then
      ReDim Preserve Tablo(Indice)
      Tablo(Indice) = Ws.Name
      Indice = Indice + 1
    End If
  Next Ws
  If Indice > 0 Then
    'Sheets(Tablo).PrintPreview
    Sheets(Tablo).PrintOut
  End If
End Sub

Bonjour Banzai64 et merci,

je viens de tester la macro, elle semble donner un bon résultat. Il faudra que je la reteste lundi en situation réelle d'utilisation.

Merci déjà pour la prompte réponse.

Si je comprends bien la macro celle-ci dit:

Pour chauqe feuille dans le classeur, si la cellule c13 est du texte alors garde ce tableau en mémoire avec comme indice son mon.

donne pour valeur indice +1

Si la valeur de l'indice est supp à zéro alors imprime tous les tableaux mis en mémoire.

Du coup je n'ai pas vérifier la toute première feuille est bien exclue.

Edit : En effet la tooute première feuille n'est pas exclue.

Bonjour

Désolé je n'avais pas vu que tu ne prenais pas la première

Nouvelle macro

Sub MakroA()
Dim Tablo()
Dim Indice As Integer
Dim I As Integer

'
' MakroA Makro
'

  For I = 2 To Sheets.Count
    If Application.WorksheetFunction.IsText(Sheets(I).Range("C13")) Then
      ReDim Preserve Tablo(Indice)
      Tablo(Indice) = Sheets(I).Name
      Indice = Indice + 1
    End If
  Next I
  If Indice > 0 Then
    'Sheets(Tablo).PrintPreview
    Sheets(Tablo).PrintOut
  End If
End Sub

Ton analyse est bonne

Ton pseudo est à la mesure de ta rapidité.

Merci pour tout.

Je reconfirmerais lundi soir mais cela me semble tout bon.

Milles merci

Comme promis Bonzai,

le test grandeur nature a été fait.

Test ancienne macro 7 min 52 sec pour 15 pages.

Test nouvelle macro 2 min 48 sec pour 18 pages.

Je crois que cela se passe de tout commentaire.

Merci