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
| Dim mxc As Integer ' maximum colonnes
'--------------- 10/10/2019 ----------
Private Sub UserForm_Activate() 'initialisation formulaire
Dim lig As Long
Dim idm As Long
Dim ann As String
FLT.Activate
mxc = FLT.Cells(1, Columns.Count).End(xlToLeft).Column - 1
FLT.Cells(2, 2).Resize(FLT.UsedRange.Rows.Count, mxc).Clear
FLT.Shapes("Choix").Select
Selection.Characters.Text = "": FLT.[B1].Select
ReDim tbm(1 To 1)
For lig = 2 To Base.UsedRange.Rows.Count
ann = Year(Base.Cells(lig, 1))
For idm = 1 To UBound(tbm)
If tbm(idm) = ann Then Exit For
If tbm(idm) = "" Then
tbm(idm) = ann
ReDim Preserve tbm(1 To UBound(tbm) + 1)
End If
Next idm
Next lig
Me.ComboBox1.List = tbm
Me.ComboBox1.Value = Year(Date)
ReDim tbm(1 To 12)
For idm = 1 To UBound(tbm)
tbm(idm) = idm
Next idm
Me.ComboBox2.List = tbm
Me.ComboBox2.ListIndex = Month(Date) - 1
ReDim tbm(1 To 53)
For idm = 1 To UBound(tbm)
tbm(idm) = idm
Next idm
Me.ComboBox3.List = tbm
Me.ComboBox3.Value = ""
Me.Top = Application.Top
Me.Left = Application.Left + FLT.[E1].Left + 30
End Sub
'--------------- 10/09/2019 ----------
Private Sub ComboBox1_Change() ' modification année
Call cal_dat
End Sub
'--------------- 10/09/2019 ----------
Private Sub ComboBox2_Change() ' modification mois
If Me.ComboBox2.ListIndex >= 0 Then Me.ComboBox3 = ""
Call cal_dat
End Sub
'--------------- 10/09/2019 ----------
Private Sub ComboBox3_Change() ' modification semaine
Call cal_dat
End Sub
'--------------- 10/09/2019 ----------
Public Sub cal_dat() ' calcul dates sélection
Dim ddd As Date ' date de début
Me.d_f.Caption = ""
Me.d_d.Caption = ""
If Me.ComboBox1.ListIndex >= 0 Then
If Me.ComboBox3 = "" And Me.ComboBox2.ListIndex >= 0 Then
Me.d_d.Caption = Format(DateSerial(Me.ComboBox1, Me.ComboBox2, 1), "dd/mm/yyyy")
Me.d_f.Caption = Format(DateAdd("m", 1, DateValue(Me.d_d)) - 1, "dd/mm/yyyy")
Call Afficher
ElseIf IsNumeric(Me.ComboBox3) Then
ddd = DateSerial(Me.ComboBox1, 1, 4)
While Weekday(ddd) <> vbMonday
ddd = ddd - 1
Wend
Me.d_f.Caption = Format(ddd - 1 + Me.ComboBox3 * 7, "dd/mm/yyyy")
Me.d_d.Caption = Format(CDate(Me.d_f.Caption) - 6, "dd/mm/yyyy")
Me.ComboBox2.ListIndex = -1
Call Afficher
End If
End If
End Sub
'--------------- 10/09/2019 ----------
Public Sub Afficher()
Dim lib As String
Dim des As Range
FLT.[A1].Value = CDate(Me.d_d.Caption)
FLT.[A2].Value = CDate(Me.d_f.Caption)
Set des = FLT.Cells(1, 2).Resize(1, mxc)
FLT.Cells(2, 2).Resize(FLT.UsedRange.Rows.Count, mxc).Clear
FLT.[A4].FormulaLocal = "=SI(ET(BD!a2>=$A$1;BD!a2<=$A$2);VRAI;FAUX)"
Base.Range("Tabl_1[#All]").AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=FLT.Range("A3:A4"), CopyToRange:=des, Unique:=False
With FLT.Cells(2, 2).Resize(Cells(Rows.Count, 2).End(xlUp).Row, mxc)
.Font.Size = 9
.Rows.AutoFit
.WrapText = False
End With
lib = IIf(Me.ComboBox3 <> "", "Semaine " & Me.ComboBox3 & " - ", Format(FLT.[A1].Value, "mmmm")) & " " & Me.ComboBox1
FLT.Shapes("Choix").Select: Selection.Characters.Text = lib: FLT.[B2].Select
End Sub |
