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
| Private Sub ComboBox1_Change()
Dim Derlg As Long, DD As Long, DF As Long
Dim Sh As Worksheet
Worksheets("Empl").Unprotect Password:="moncef"
Worksheets("Master").Unprotect Password:="moncef"
Worksheets("Master").Visible = True
'On inhibe la mise à jour affichage écran
Application.ScreenUpdating = False
With Sheets("Empl")
'On supprime l'éventuel filtre automatique
.AutoFilterMode = False
'La dernière ligne remplie de la colonna A
Derlg = .Range("A" & .Rows.Count).End(xlUp).Row
'Si ComboBox1 non vide
If Me.ComboBox1.Value <> "" Then
'En DD (date début), On transforme le contenu de DTPicker1 en Long
DD = CLng(Me.DTPicker1.Value)
'En DF (date Fin), on transforme le contenu de DTPicker2 en Long
DF = CLng(Me.DTPicker2.Value)
If DF > DD Then
'On filtre la colonne A entre DD et DF
.Range("A7:J" & Derlg).AutoFilter field:=1, Criteria1:=">=" & DD, Criteria2:="<=" & DF, Operator:=xlAnd
'Et on filtre la colonne H sur le texte entrée dans ComboBox1
.Range("A7:H" & Derlg).AutoFilter field:=8, Criteria1:=Me.ComboBox1.Text
'Si le résultat du filtre comporte plus d'une ligne (y compris la ligne 7, celle des titres)
If .Range("A7:A" & Derlg).SpecialCells(xlCellTypeVisible).Count > 1 Then
On Error Resume Next
'Si la feuille nommée par la valeur de ComboBox1 existe, on instancie dans Sh cette feuille
Set Sh = Sheets(Me.ComboBox1.Text)
On Error GoTo 0
'Si la feuille nommée par la valeur de ComboBox1 n'existe pas, Sh est vide (nothing)
If Sh Is Nothing Then
'On crée une nouvelle feuille qu'on nomme par la valeur de ComboBox1
Worksheets("Master").Copy After:=Sheets(Sheets.Count)
Set Sh = ActiveSheet
Sh.Name = Me.ComboBox1.Text
End If
'On copie le résultat issu du filtre dans la première ligne vide de la feuille Sh
.Range("A8:F" & Derlg).SpecialCells(xlCellTypeVisible).Copy Sh.Cells(Sh.Rows.Count, 1).End(xlUp)(2)
Set Sh = Nothing
End If
ActiveSheet.Select
Columns("A:C").ColumnWidth = 18
Columns("D:F").ColumnWidth = 10
Columns("G:I").ColumnWidth = 18
End If
'On supprime le filtre automatique précédent
.AutoFilterMode = False
Range("A14:I65536").Sort Key1:=Range("A14"), Order1:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
End If
End With
Worksheets("Empl").Protect Password:="moncef"
Worksheets("Master").Protect Password:="moncef"
Worksheets("Master").Visible = False
ActiveSheet.Protect Password:="moncef"
Application.ScreenUpdating = True
ActiveSheet.Select
If Range("F4") = "Bourget" Then
Worksheets("Adresse").Visible = True
Worksheets("Adresse").Select
Range("A2:H2").Copy
Sheets("Bourget").Select
Range("F3").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Range("F4").Select
Worksheets("Adresse").Visible = False
Application.ScreenUpdating = True
End If
If Range("F4") = "Bussey" Then
Worksheets("Adresse").Visible = True
Worksheets("Adresse").Select
Range("A1:H1").Copy
Sheets("Bussey").Select
Range("F3").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Range("F4").Select
Worksheets("Adresse").Visible = False
Application.ScreenUpdating = True
End If
End Sub |
