impression par CheckBox - VB/VBA/VBS - Programmation
MarshPosté 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
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