Imprimer

[Cougar]

Bonjour le forum,

Voici mon code pour lancer l’impression automatiquement des feuilles. Le nombre de feuilles à imprimer est en fonction de la valeur en « B6 ». Est-ce qu’il aurait une façon plus simple d’écrire ce code ?

If Range("b6") = 1 Then
Sheets(Array("Feuil1")).Select
ActiveWindow.SelectedSheets.PrintOut From:=1, To:=1, Copies:=1, Collate _
:=True
Else
If Range("b6") = 2 Then
Sheets(Array("Feuil1", "Feuil2")).Select
ActiveWindow.SelectedSheets.PrintOut From:=1, To:=2, Copies:=1, Collate _
:=True
Else
If Range("b6") = 3 Then
Sheets(Array("Feuil1", "Feuil2", "Feuil3")).Select
ActiveWindow.SelectedSheets.PrintOut From:=1, To:=3, Copies:=1, Collate _
:=True
Else
If Range("b6") = 4 Then
Sheets(Array("Feuil1", "Feuil2", "Feuil3", "Feuil4")).Select
ActiveWindow.SelectedSheets.PrintOut From:=1, To:=4, Copies:=1, Collate _
:=True
Else

Etc.

Merci de pour votre aide.

 

[CBernardT]

Re : Imprimer

Bonjour Cougar et le forum,

Un essai de commande de l'impression :

Sub Imprimer()
Dim i As Byte, X As Byte, N As Byte, M As Byte
Application.ScreenUpdating = False
X = Sheets("Accueil").Range("B6").Value ' Nombre de feuilles à imprimer
N = 2 ' première feuille à imprimer après la feuille "Accueil", feuille servant d'interface.
M = N-1 + X ' Ajout du nombre de feuilles à imprimer
For i = N To M
Worksheets(i).PrintOut Copies:=1, Collate:=True
Next i
Application.ScreenUpdating = True
End Sub

Cordialement

Bernard

 

[ERIC S]

Re : Imprimer

Bonjour à vous deux et au forum

non testé mais je garde l'idée initiale du nom de feuille plutôt que de l'indice que l'on maîtrise plus ou moins bien (ordre de création des feuilles, suppressions/ajouts...)

Sub essaiimprim()
Dim nombre As Single, zone As String
nombre = Sheets("Accueil").Range("B6").Value ' Nombre de feuilles à imprimer
If nombre < 1 Then Exit Sub
zone = "Feuil1"
If nombre > 1 Then
For I = 2 To nombre
zone = zone & ", Feuil" & I
Next
End If
Sheets(Array(zone)).Select
ActiveWindow.SelectedSheets.PrintOut From:=1, To:=4, Copies:=1, Collate _
:=True
End Sub