XL 2019 VBA AFFICHAGE CRITÈRES DE FILTRAGE

[insulae]

Bonjour,

Dans cette jolie formule... Comment afficher les critères sélectionnés dans les filtres dans la cellule B3 sans passer par la MsgBox (fenêtre qui s'ouvre) pour sélection de la cellule de destination (pour affichage des critères) ?

Merci !

---

Dim xFilter As AutoFilter
Dim TargetFilter As Filter
Dim TargetField As String
Dim xOut As String
Dim OutRng As Range
If ActiveSheet.AutoFilterMode = False Then
Application.StatusBar = False
Exit Sub
End If
Range("B3").Select
xTitleId = "AFFICHAGE CRITÈRES FILTRAGE DVF"
Set OutRng = Application.Selection
Set OutRng = Application.InputBox("", xTitleId, OutRng.Address, Type:=8)
Set xFilter = ActiveSheet.AutoFilter
For i = 1 To xFilter.Filters.Count
TargetField = xFilter.Range.Cells(1, i).Value
Set TargetFilter = xFilter.Filters(i)
If TargetFilter.On Then
On Error GoTo OutNext
xOut = xOut & TargetField & TargetFilter.Criteria1 & " / "
Select Case TargetFilter.Operator
Case xlAnd
xOut = xOut & "et / " & TargetField & TargetFilter.Criteria2 & " / "
Case xlOr
xOut = xOut & "ou / " & TargetField & TargetFilter.Criteria2 & " / "
Case xlBottom10Items
xOut = xOut & " (bottom 10 items)" & " / "
Case xlBottom10Percent
xOut = xOut & " (bottom 10%)"
Case xlTop10Items
xOut = xOut & " (top 10 items)"
Case xlTop10Percent
xOut = xOut & " (top 10%)"
End Select
End If
Next
OutRng.Value = xOut
OutNext:
xOut = xOut & TargetField & "=Filtres multiples" & " / "
ErrorHandler:
Resume Next

 

[Staple1600]

Bonjour le fil, insulae

insulae
Ton code modifié pour mettre xOut en B3

Sub filtres()
Dim xFilter As AutoFilter, TargetFilter As Filter
Dim TargetField$, xOut$, OutRng As Range
If ActiveSheet.AutoFilterMode = False Then
Application.StatusBar = False
Exit Sub
End If
Set OutRng = Range("B3")
Set xFilter = ActiveSheet.AutoFilter
For i = 1 To xFilter.Filters.Count
TargetField = xFilter.Range.Cells(1, i).Value
Set TargetFilter = xFilter.Filters(i)
  If TargetFilter.On Then
  On Error GoTo OutNext
  xOut = xOut & TargetField & TargetFilter.Criteria1 & " / "
  Select Case TargetFilter.Operator
      Case xlAnd
      xOut = xOut & "et / " & TargetField & TargetFilter.Criteria2 & " / "
      Case xlOr
      xOut = xOut & "ou / " & TargetField & TargetFilter.Criteria2 & " / "
      Case xlBottom10Items
      xOut = xOut & " (bottom 10 items)" & " / "
      Case xlBottom10Percent
      xOut = xOut & " (bottom 10%)"
      Case xlTop10Items
      xOut = xOut & " (top 10 items)"
      Case xlTop10Percent
      xOut = xOut & " (top 10%)"
  End Select
  End If
Next
OutRng.Value = xOut
OutNext:
xOut = xOut & TargetField & "=Filtres multiples" & " / "
ErrorHandler:
Resume Next
End Sub