imprimer plusieurs fois la meme feuille

[fenec]

Bonjour le forum
J’utilise cette macro qui fonctionne très bien mais auquel je souhaiterais ajouter un msgbox(nombre d’impression) afin de ne pas aller manuellement dans ma macro pour définir le nombre de copie :
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
ActiveWindow.SelectedSheets.PrintOut Copies:=2, Collate:=True
ActiveWindow.SelectedSheets.PrintOut Copies:=3, Collate:=True

Ect…

Private Sub CommandButton11_Click()
Dim Ligne As Integer
Dim Colonne As Byte
Dim Fin As Integer
Fin = Range("C65535").End(xlUp).Row
For Ligne = 1 To Fin
For Colonne = 1 To 5
If Cells(Ligne, Colonne) <> "" Then GoTo Saut
Next Colonne
Rows(Ligne & ":" & Ligne).EntireRow.Hidden = True
Saut:
Next Ligne
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
Rows("1:" & Fin).EntireRow.Hidden = False
End Sub


D’avance merci

 

[Hulk]

Re : imprimer plusieurs fois la meme feuille

Hello,

Comme ceci... mais avec une ImputBox !

Private Sub CommandButton1_Click()

    Dim Ligne As Integer
    Dim Colonne As Byte
    Dim Fin As Integer
    Dim nbrCopie As Integer
    
    On Error Resume Next
        
    Fin = Range("C65535").End(xlUp).Row
    
    For Ligne = 1 To Fin
        For Colonne = 1 To 5
            If Cells(Ligne, Colonne) <> "" Then GoTo Saut
        Next Colonne
        Rows(Ligne & ":" & Ligne).EntireRow.Hidden = True
Saut:
    Next Ligne
    
    nbrCopie = InputBox("Combien de copie voulez-vous faire ?", Title:="Copies")
    
    If nbrCopie = 0 Then
        Rows("1:" & Fin).EntireRow.Hidden = False
        Exit Sub
    Else
        ActiveWindow.SelectedSheets.PrintOut Copies:=nbrCopie, Collate:=True
    End If
    
    Rows("1:" & Fin).EntireRow.Hidden = False
    
End Sub

 

[fenec]

Re : imprimer plusieurs fois la meme feuille

Re le forum et bonjour Hulk
merci pour ta réponse c'est nickel viens de tester

je venais de trouver en écrivant ceci quand penses-tu ?
vu que tu integre à la tienne:

Dim nbrCopie As Integer

On Error Resume Next

puis un if

If nbrCopie = 0 Then
Rows("1:" & Fin).EntireRow.Hidden = False
Exit Sub


merci de m'eclairer sur ton supplément

et encore merci pour ta réponse rapide

cordialement

Fenec

 

[fenec]

Re : imprimer plusieurs fois la meme feuille

re,
oups oublié de mettre mon code


Private Sub CommandButton11_Click() 'Imprimer Bon de Commande sans les lignes vides

Dim Ligne As Integer
Dim Colonne As Byte
Dim Fin As Integer
Fin = Range("C65535").End(xlUp).Row
For Ligne = 1 To Fin
For Colonne = 1 To 5 'Ici pour vérifier les colonnes de A a E
If Cells(Ligne, Colonne) <> "" Then GoTo Saut
Next Colonne
Rows(Ligne & ":" & Ligne).EntireRow.Hidden = True
Saut:
Next Ligne
x = InputBox("combien voulez vous d'impression")
ActiveWindow.SelectedSheets.PrintOut Copies:=x, Collate:=True
Rows("1:" & Fin).EntireRow.Hidden = False
End Sub


a+

 

[Hulk]

Re : imprimer plusieurs fois la meme feuille

Re,

Si j'ai bien compris ce que tu demandes...

Teste avec ton code sans écrire un nombre dans l'InputBox ou sors de l'InputBox en cliquant sur la croix, tu verras..

On Error Resume Next évite le message d'erreur (tu peux gérer les erreurs plus proprement si tu veux).

If nbrCopie = 0 Then
Rows("1:" & Fin).EntireRow.Hidden = False
Exit Sub

Un if parce :

Si rien dans l'InputBox (0 = "") il ré-affiche les lignes et Exit Sub pour qu'il sorte de la procédure.
Autrement il imprime le nombre de x (ex. si tu saisis un nbr mais que tu cliques sur la croix pour sortir).

 

[fenec]

Re : imprimer plusieurs fois la meme feuille

bonjour le forum et Hulk

merci pour ces précisions te remercie

cordialement
a+ et bon week-end

fenec

 

[Fo_rum]

Re : imprimer plusieurs fois la meme feuille

Salut,

en passant par la boîte de dialogue, on peut même choisir l'imprimante et d'autres options.

Private Sub CommandButton1_Click()
  Dim Li As Long
  For Li = 1 To Cells(Rows.Count, 3).End(xlUp).Row
    Rows(Li).Hidden = Application.CountBlank(Range("A" & Li & ":E" & Li)) = 5
  Next
  Application.Dialogs(xlDialogPrint).Show
  Cells.EntireRow.Hidden = False
End Sub