[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..
 

Fichiers joints

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
Lone-wolf a dit:
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.

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

fouzyyy

XLDnaute Nouveau
RE
Idem Malheureusement ce code n'as pas fonctionner pour moi ...
et je galère toujours pour imprimer les resulta de filtre
 

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.

dates.gif
 
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
 

Fichiers joints

Dernière édition:

fouzyyy

XLDnaute Nouveau
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.
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


Haut Bas