Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

[Résolu]Impression Résultat filtre date ..listbox

fouzyyy

XLDnaute Nouveau
Bonjour

J'ai un userform depuis le quelle je saisisse des donnés dans un tableau .. bref tout marche bien.
anisi ce userform contient une lisbox laquelle je l'utilse pour filtre les donnés entre 2 date..et l affiche dnas la listbox... cad la lisbox contient les donne filrer..

voici le code utiliser pour filtrer ces données


VB:
Private Sub RechEntr_Click()
Dim Debut As String, fin As String
Dim Nblg As Long, lig As Long
Dim Dico, Tablo
Dim j As Long

EntrMois.Clear

Debut = Me.EntrDD
If Not IsDate(Debut) Then
    MsgBox "Veuillez Choisir Une Date"
    EntrDD.BorderColor = vbRed
    EntrDD.SetFocus
    Exit Sub
End If

fin = Me.EntrDF
If Not IsDate(fin) Then
    MsgBox "Veuillez Choisir Une Date"
    EntrDF.BorderColor = vbRed
    EntrDF.SetFocus
    Exit Sub
End If
Application.ScreenUpdating = False

With FE

    Nblg = FE.Range("A" & .Rows.Count).End(xlUp).Row 'dernière ligne
    Tablo = FE.Range("A5:F" & Nblg).Value
    Set Dico = CreateObject("Scripting.dictionary")
    For i = LBound(Tablo, 1) To UBound(Tablo, 1)
        If Tablo(i, 1) >= CDate(Debut) And Tablo(i, 1) <= CDate(fin) And Tablo(i, 2) <> "" Then
          
               Me.EntrMois.AddItem  'on ajoutte dans la ListBox
              
                For j = LBound(Tablo, 2) To UBound(Tablo, 2)  ' 'qu'on remplit avec les 6 colonnes: a à f
                    Me.EntrMois.List(lig, j - 1) = Tablo(i, j)
                
                Next j
                 lig = lig + 1
                        End If

                               Next i
                  Application.ScreenUpdating = True
                                             End With
End Sub

ce code marche très très bien ..le résultat obtenu dans la listbox correspondre parfaitement a mes critères date.

Le PROBLEM...

en arrivant pour imprimer les résultat de la listbox je me trouve avec tout les donnée de la feuil
j'aimerais que quand je filtre via l'userform que la feuil des donne se filtre aussi pour que je puisse inmrimer les donne qui correspondre au resulta de la listbox

Veuilez trouver ci Joint mon fichier pour bien comprendre mon problème

Merci..
 

Pièces jointes

  • Teste F .xlsm
    204 KB · Affichages: 61

Lone-wolf

XLDnaute Barbatruc
Bonjour fouzyyy

@fouzyyy : un exemple à tester.

VB:
    With Me.EntrMois
        lg = .List.Count
        cl = .Columns.Count
    End With

    ReDim Tablo(1 To lg, 1 To cl + 1)

    With FE
        Nblg = .Range("A" & .Rows.Count).End(xlUp).Row    'dernière ligne
        Tablo = .Range("A5:F" & Nblg).Value
        Set Dico = CreateObject("Scripting.dictionary")
        For i = LBound(Tablo, 1) To UBound(Tablo, 1)
            If Tablo(i, 1) >= CDate(Debut) And Tablo(i, 1) <= CDate(fin) And Tablo(i, 2) <> "" Then

                Me.EntrMois.AddItem  'on ajoutte dans la ListBox

                For j = LBound(Tablo, 2) To UBound(Tablo, 2)  ' 'qu'on remplit avec les 6 colonnes: a à f
                    Me.EntrMois.List(lig, j - 1) = Tablo(i, j)

                Next j
                lig = lig + 1
            End If

        Next i
    End With

    With Sheets(nom de la feuille à imprimer)
        .Range("a5:f60").ClearContents
        .Range("a5").Resize(UBound(Tablo, 1), UBound(Tablo, 2)) = Tablo
    End With
    With ActiveSheet.PageSetup
        .PrintArea = "$A$5:$f$60"
        .PrintPreview
        '.PrintOut
    End With
        Application.ScreenUpdating = True
 
Dernière édition:

Lone-wolf

XLDnaute Barbatruc
Re

@fouzyyy : désolé, je n'ai pas pu tester.

EDIT: j'ai trouvé ceci sur le forum, à tester.

With Me
Tablo() = .ListBox1.List
j = .ListBox1.ColumnCount
i = .ListBox1.ListCount
End With
Range("A5:" & Cells(i, j).Address) = Tablo()
With ActiveSheet.PageSetup
.PrintArea = "$A$5:$f$60"
.PrintPreview
'.PrintOut
End With

Mais si tu es sous Excel 2007, pas sûr que ça fonctionne. Sinon, filtre directement les lignes sur la feuille et tu met les lignes de code pour l'impression.
 
Dernière édition:

fouzyyy

XLDnaute Nouveau


Ok Lone-wolf je vais tester ce code .....Merci Encore........
 

Lone-wolf

XLDnaute Barbatruc
Bonsoir fouzyyy, le Forum

Il te faut dans ce cas, filtrer directement sur la feuille, comme je l'ai dit dans mon précédent message.

EDIT: Les dates sur la feuille ne sont pas de vraies dates, je te conseil de les modifier si tu veux appliquer le filtre.

 
Dernière édition:

Lone-wolf

XLDnaute Barbatruc
Re fouzyyy

@fouzyyy

Essaie cette macro, à mettre dans un module du formulaire. Ensuite dans le bouton de filtrage de la listbox avant End Sub, tu rajoute Call Imprimer.

EDIT: avant de faire le test sur ton classeur, utilise le classeur joint pour voir. Double-clique sur la feuille pour afficher le formulaire.
Regarde aussi comment j'ai fait la mise en page, marges personnalisées etc.

VB:
Private Sub Imprimer()
Dim derlig&, i&, plage As Range, deb As Date, fin As Date

With Sheets("ATELIER")
    derlig = .Range("a" & Rows.Count).End(xlUp).Row

    deb = CDate(TextBox1.Value)
    fin = CDate(TextBox2.Value)

    For i = 6 To derlig
        If CDate(.Cells(i, 1)) >= deb And CDate(.Cells(i, 1)) <= fin Then
            .Cells(i, 1).EntireRow.Hidden = False
        Else
            .Cells(i, 1).EntireRow.Hidden = True
        End If
    Next i
        Set plage = .Range("a5:f" & .Range("a" & Rows.Count).End(xlUp).Row)

        Unload Me
        .PageSetup.PrintArea = plage.Address
        .PrintPreview
        .Rows("6:106").Hidden = False
End With

End Sub
 

Pièces jointes

  • Classeur-exemple.xlsm
    20.1 KB · Affichages: 78
Dernière édition:

fouzyyy

XLDnaute Nouveau

Merci Lone-wolf
Votre code a tres bien fonctionner

je l'ai inséré dans le bouton aperçu de l'userform et il a très bien fonctionner ... je vais l'utiliser comme ca et j'esper que ca dure............

Je vais remercier infiniment ..

on vas que mon problème est résolu ......
 

Discussions similaires

Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…