impression par CheckBox

impression par CheckBox - VB/VBA/VBS - Programmation

Marsh Posté le 02-08-2015 à 23:42:52    

Bonjour a tous
 
 
 
Voici mon souci  
 
 
 
J’ai un code d’impression que je voudrais modifier
 
Private Sub CmbValider_Click()
Dim I As Integer, Nblg As Long, Ligne As Long
 
 Application.ScreenUpdating = False ' Masquage rafraichissement écran
 With Sheets("BASE" ) ' Tout se passe avec cette page
 Nblg = .Range("B" & Rows.Count).End(xlUp).Row ' Nombre de ligne de la base de données
 Ligne = 6 ' ligne pour le titre des critéres
 For I = 1 To 9 ' Pour les 9 CheckBox
 If Me.Controls("CheckBox" & I) = True Then ' Si est coché
 Ligne = Ligne + 1 ' Ligne pour écrire le critère
 .Range("K" & Ligne) = Me.Controls("CheckBox" & I).Caption & "*" ' Ecriture du critère
 End If
 Next I
 If Ligne > 6 Then ' Si on a écrit au moins un critère
 .Range("B6" ) = "Filtre" ' Nomme la colonne à filtrer
 .Range("K6" ) = "Filtre" ' Titre des critères (identique à la colonne à filtrer)
 ' On filtre (filtre avancé) la zone en fonction des critères
 .Range("B6:B" & Nblg).AdvancedFilter Action:=xlFilterInPlace, criteriarange:=.Range(.Range("K6" ), .Cells(Ligne, "K" ))
 .Range("B6" ).ClearContents ' On efface le nom de la colonne filtrée
 .PageSetup.PrintArea = "A1:G" & Nblg ' Zone d'impression
 .Visible = xlSheetVisible ' La page "Data" visible
 Me.Hide ' On masque l'userform
 .PrintPreview ' Aperçu avant impression
 .Visible = xlSheetHidden ' La page "Data" masquée
 If .FilterMode = True Then .ShowAllData ' Si on était en mode filtre alors on affiche tout
 .Range(.Range("K6" ), .Cells(Ligne, "K" )).ClearContents ' Efface la zone des critères
 Application.ScreenUpdating = True ' Autorise le raffraichissement écran
 UserForm3.Show ' Affiche l'Userform
 End If
 End With
 
 End Sub
 
 
 
Je sélectionne un tiroir pas de problème imprime
Mais je voudrais sélectionner plusieurs tiroirs et les imprimer sur plusieurs feuilles  
Une feuille par tiroir
Tiroir D sur une feuille  
Tiroir F sur une autre feuille
Tiroir K sur une autre feuilles  
Je vous envoie un fichier test
 
http://www.cjoint.com/c/EHbniEw7rs4  
 
 
 
 
 
Cordialement  
 
 
 
 
 
 
 
Aiglon74

Reply

Marsh Posté le 02-08-2015 à 23:42:52   

Reply

Sujets relatifs:

Leave a Replay

Make sure you enter the(*)required information where indicate.HTML code is not allowed