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
| Dim Ws As Worksheet
Dim ListFiltre()
Dim FiltreCourant As String, f, VFiltre As Boolean
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Y As String, N As String
Y = "þ"
N = "o"
If Target.Column = 22 And Target.Count = 1 Then
Target = IIf(Target = Y, N, Y) 'Police Wingdings
Cancel = True
Exit Sub
End If
End Sub
Private Sub UNSELECT_AUTO_Click()
Dim N As String
N = "o"
Range("V3:V500").Value = N
End Sub
Private Sub AUTO_SELECT_Click()
'Start = Timer
Application.ScreenUpdating = False 'Désctive le rafraîchissement de l'écran
Application.EnableEvents = False 'Désactivation des procédures événementielles
Unprotect
VFiltre = True
If ActiveSheet.AutoFilterMode Then
Filtre
Else
VFiltre = False
End If
Dim Formule As String, ListeVal(), i As Long
ListeVal = Array("TINTIN", "TOTO", "TATA")
Formule = "=IF(OR("
For i = LBound(ListeVal) To UBound(ListeVal)
Formule = Formule & "RC[-8]=""" & ListeVal(i) & ""","
Next i
Formule = Mid(Formule, 1, Len(Formule) - 1) & "),""þ"",""o"")"
With ThisWorkbook.Worksheets("COMMANDES").Cells(2, 22).Resize(ThisWorkbook.Worksheets("COMMANDES").UsedRange.Rows.Count - 1, 1).SpecialCells(xlCellTypeVisible)
.Value = [Formule]
.Value = .Value
.Font.Name = "Wingdings"
End With
If VFiltre = True Then
RestaureFiltre
End If
Protect AllowFiltering:=True
Application.ScreenUpdating = True 'Désctive le rafraîchissement de l'écran
Application.EnableEvents = True 'Désactivation des procédures événementielles
'MsgBox "durée du traitement: " & Timer - Start & " secondes"
End Sub
Sub Filtre()
Set Ws = ActiveSheet
With Ws.AutoFilter
FiltreCourant = .Range.Address
With .Filters
ReDim ListFiltre(1 To .Count, 1 To 3)
For f = 1 To .Count
With .Item(f)
If .On Then
ListFiltre(f, 1) = .Criteria1
If .Operator Then
ListFiltre(f, 2) = .Operator
ListFiltre(f, 3) = .Criteria2
End If
End If
End With
Next
End With
End With
Ws.AutoFilterMode = False
End Sub
Sub RestaureFiltre()
Dim col As Integer
Ws.AutoFilterMode = False
For col = 1 To UBound(ListFiltre(), 1)
If Not IsEmpty(ListFiltre(col, 1)) Then
If ListFiltre(col, 2) Then
Ws.Range(FiltreCourant).AutoFilter field:=col, _
Criteria1:=ListFiltre(col, 1), _
Operator:=ListFiltre(col, 2), _
Criteria2:=ListFiltre(col, 3)
Else
Ws.Range(FiltreCourant).AutoFilter field:=col, _
Criteria1:=ListFiltre(col, 1)
End If
End If
Next
End Sub |
Partager