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
| Option Explicit
Private MODULE
' Module contenant les procédures utilisées dans le classeur illustrant le tutoriel Filtres avancés d'excel
Function ExportByFilter(znData As Range, znCriteria As Range, Optional znExport As Range) As Long
' Author : Philippe Tulliez http://philippe.tulliez.be
' Date : 01/11/2012
' Version : 1.0
' Procédure d'exportation basée sur le filtre élaboré
' Valeur renvoyée : Nombre d'enregistrements exporté
' znData ' Table de données
' znCriteria ' Zone des critères
' [znExport] ' Zone d'exportation (si vide Exporte tout, en créant une feuille)
If znExport Is Nothing Then ' Création de la feuille d'export et coloration en rouge
Worksheets.Add before:=Sheets(1)
With Worksheets(1): ActiveCell = .Range("A1"): .Tab.Color = vbRed: End With
Set znExport = ActiveCell
End If
znData.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=znCriteria, CopyToRange:=znExport
ExportByFilter = znExport.CurrentRegion.Rows.Count - 1
End Function
Public Sub ContrlFilterSelection()
Application.ScreenUpdating = False
Dim znSelection As Range
Dim argData As Range, argCriteria As Range, argExport As Range
Dim row As Byte ' N° de ligne
Range("pnClearCriteria").Clear
Set znSelection = Range("dbZnSelection") ' Zone sélection feuille [ControlFilters]
Set argData = Range("dbZnDataList3") ' Table de données feuille [DataList3]
Debug.Print znSelection.Address
row = Range("pSelectionChoice") ' N° sélection dans la liste
With Application.WorksheetFunction
' Zone Critères
If Len(.Index(znSelection, row, 1)) Then Set argCriteria = Range(.Index(znSelection, row, 1))
' Zone Export
If Len(.Index(znSelection, row, 2)) Then Set argExport = Range(.Index(znSelection, row, 2))
End With
Application.ScreenUpdating = True
MsgBox "Nombre filtré " & ExportByFilter(argData, argCriteria, argExport)
End Sub
Function Formula(rng As Range) As String
' Fonction qui renvoie la formule de la cellule se trouvant en rng
Formula = rng.FormulaLocal
End Function |
Partager