Discussion :

[ESVBA]

Bonjour,

j'ai un tableau structuré "TabSaisie" pour lequel je veux imprimer les données correspondantes à deux filtres simultanés :
1) un filtre pour le choix de la salle
2) un filtre pour le choix de l'armoire

J'extrais les éléments uniques de ces deux colonnes en mettant les valeurs dans deux "dictionary" puis dans deux variables à une dimension.

Mon filtre filtrant sur le format d'affichage différent du format des données du "Dictionary", je convertis au cas par cas mes valeurs de la variable dimensionnée pour correspondre à la valeur affichée.

Dans les combinaisons possibles de ces deux variables, il existe des références d'armoires qui n'existent pas pour certaines salles.
Je souhaite éviter l'impression de feuilles inutiles pour ces cas irréalistes.

Pour cela, je compte donc le nombre de lignes restantes après application de la combinaison du filtre pour les deux colonnes.

Et ça ne fonctionne pas. J'ai toujours plus d'éléments.

Or je viens de constater que c'est mon filtrage qui ne fonctionne pas.
Il reste toujours quelques lignes supplémentaires, lignes qui ne sont pas imprimées et qui appartiennent bien au "Listobject".

Filtre pour "Salle 001 Armoire 01" (valeurs "dictionary" : "1" et "1")


Voici mon code nettoyé des choses inutiles :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
Sub Imprimer()
     '--- Efface le flltre car des problèmes en créant la liste ordonnées avant traitement pour le "Set P =..."
    Dim Tableau As Range
 
    Set Tableau = Range("TabSaisie")
    Call TS_Filtres_Effacer(Tableau)
 
    ' Dernière ligne du tableau
    Dim DernLign As Long
    DernLign = Cells(Cells.Rows.Count, 1).End(xlUp).Row
 
    '---
    Dim P As Range, c As Range
 
    Application.EnableEvents = False
 
    With Sheets("Saisie inventaire").[A6].CurrentRegion
        Set P = .Columns(.Columns.Count + 2)
        Application.StatusBar = "P adresse : " & P.Address
        P.ClearContents
        P(1) = 1
        P.DataSeries 'numérotation
        'Tri sur Salle > Armoire > Etagere > Grp > Dénomination
        Range("H8").Select
        With ActiveWorkbook.Worksheets("Saisie inventaire").ListObjects("TabSaisie").Sort
            .SortFields.Clear
            .SortFields.Add Key:=Range("TabSaisie[Salle]"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
            .SortFields.Add Key:=Range("TabSaisie[Armoire/Etagère]"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
            .SortFields.Add Key:=Range("TabSaisie[Etage]"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
            .SortFields.Add Key:=Range("TabSaisie[Grp]"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
            .SortFields.Add Key:=Range("TabSaisie[Dénominations]"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
 
        '--- Salles existantes
        Dim mondico As Scripting.Dictionary
        Dim ce As Range
        Dim i As Byte
        Dim j As Byte
        Dim ListeSalle As Variant
 
        Set mondico = CreateObject("Scripting.Dictionary")
        For Each ce In Feuil1.Range("B6:B" & DernLign)
            With ce
                If Not mondico.Exists(.Value) Then mondico.Add .Value, .Value
            End With
        Next ce
 
        'Place dans une variable dimensionnée le résultat du dictionnaire
        ListeSalle = mondico.Items
 
        'Efface le dictionnaire
        Set mondico = Nothing
 
        '--- Armoires existantes
        'Dim mondico As Scripting.Dictionary
        Dim ListeArmoire As Variant
 
        Set mondico = CreateObject("Scripting.Dictionary")
        For Each ce In Feuil1.Range("C6:C" & DernLign)
            With ce
                If Not mondico.Exists(.Value) Then mondico.Add .Value, .Value
            End With
        Next ce
 
        ListeArmoire = mondico.Items
 
        '---
        Application.StatusBar = UBound(ListeSalle) - LBound(ListeSalle) & " salles et " & _
                                UBound(ListeArmoire) - LBound(ListeArmoire) & " armoires = " & (UBound(ListeSalle) - LBound(ListeSalle)) * (UBound(ListeArmoire) - LBound(ListeArmoire)) & " cas"
 
        '--- Filtre et imprime en PDF
        Dim SearchSalle
        Dim SearchArmoire
 
        Dim NomFichierPDF As String
        Dim Vide As String
        Vide = ""
 
        ' Boucle sur Salle, 1 2 3 4 5 6 7 8 9 Réserve
        For i = LBound(ListeSalle) To UBound(ListeSalle)
            '--- Filtre ne fonctionne qu'avec la valeur d'affichage (ex. "001" et non le "1" provenant du Dictionary)
            'Filtre suivant le format de ce qui est affiché donc change en fonction nombre ou texte
            If IsNumeric(ListeSalle(i)) Then
                SearchSalle = Format(ListeSalle(i), "000")
            Else
                SearchSalle = ListeSalle(i)
            End If
 
            ' Boucle sur Armoire, (Hors), Etagère ou (vide)
            For j = LBound(ListeArmoire) To UBound(ListeArmoire)
                '--- Filtre ne fonctionne qu'avec la valeur d'affichage (ex. "01" et non le "1" provenant du Dictionary)
                If IsNumeric(ListeArmoire(j)) Then
                    SearchArmoire = Format(ListeArmoire(j), "00")
                Else
                    SearchArmoire = ListeArmoire(j)
                End If
 
                '--- Nom du fichier
                NomFichierPDF = "Salle " & SearchSalle & "_Armoire " & SearchArmoire & ".pdf"
 
                '--- Filtre réelle
                Range("TabSaisie[[#Headers],[Salle]]").Select
                Dim x
                'x = TS_Sélectionner(Tableau)
 
                ActiveSheet.ListObjects("TabSaisie").Range.AutoFilter Field:=2, Criteria1:=SearchSalle     'Salle   en colonne 2
                ActiveSheet.ListObjects("TabSaisie").Range.AutoFilter Field:=3, Criteria1:=SearchArmoire   'Armoire en colonne 3
 
                'Filtres actualisés donc actualise les cellules avec les filtres
                Calculate
 
                DoEvents
 
                'Impression si nécessaire : Au moins une réponse
                If Range("H6:H" & DernLign).SpecialCells(xlCellTypeVisible).Count > 0 Then
                     'Aperçu avant impression
                    'ActiveSheet.PrintPreview
 
                     ' Explique à l'utilisateur comment envoyer le fichier
                    On Error GoTo ErreurRefLib
                    'Efface le fichier PDF existant
                    If Dir(ActiveWorkbook.Path & "\" & NomFichierPDF) <> "" Then
                        Kill ActiveWorkbook.Path & "\" & NomFichierPDF
                    End If
 
                    ' Crée le fichier PDF pour la bonne salle et armoire
                    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
                                                    filename:=ActiveWorkbook.Path & "\" & NomFichierPDF, _
                                                    Quality:=xlQualityStandard, _
                                                    IncludeDocProperties:=False, _
                                                    IgnorePrintAreas:=False, _
                                                    OpenAfterPublish:=False
                    DoEvents
                    On Error GoTo 0
                Else
                    Vide = Vide & NomFichierPDF & " :: "
                End If
 
                '--- Efface le filtre
                Set Tableau = Range("TabSaisie")
                Call TS_Filtres_Effacer(Tableau)
            Next j
        Next i
 
        '--- Efface la ligne de classement initial
        '.EntireRow.Sort P, xlAscending, Header:=xlYes 'remise dans l'ordre initial
        'P.ClearContents 'RAZ
    End With
 
 
ErreurRefLib:
    MsgBox "Impossible de sauvegarder en pdf. Référence introuvable ou manquante." & Chr(13) & _
           ActiveWorkbook.Path & "\" & NomFichierPDF & ".pdf"
 
FinMacro:
 
    MsgBox "Vide" & Chr$(13) & Vide
    '--- réinitialisation
    Application.StatusBar = ""
    Application.EnableEvents = True
End Sub

Pourquoi ai-je encore les lignes hors filtre d'affichées ?

Rq: J'ai une fonction volatile pour afficher en "J2" et "J3" les valeurs de filtres. d'oû les "Calculate".

Merci d'avance.

ESVBA