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
| Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim rDate As Range, kR As Long, kCdu As Long, kCNom As Long, kCAbsent As Long, sNom As String
If Target.Count > 1 Then Exit Sub
If Intersect(Target, Range("t_roulement")) Is Nothing Then
'--- rien, hors tableau t_roulement
Else
Range("A1") = Range("B" & Target.Row)
Set rDate = Range("t_abscence[[DU]]").Find(Cells(Target.Row, 2).Value, , , xlWhole)
If rDate Is Nothing Then
'--- rien
Else
MsgBox "absence de " & rDate.Offset(0, -1) & " à partir du " & Format(rDate, "dd.mm.yyyy")
End If
Set rDate = Nothing
End If
If Intersect(Target, Range("t_abscence")) Is Nothing Then
'--- rien, hors tableau t_absence
Else
kCdu = Range("t_abscence[[DU]]").Column
kCNom = Range("t_abscence[[Nom]]").Column
kR = Target.Row
sNom = Cells(kR, kCNom)
If IsDate(Cells(kR, kCdu)) And Len(sNom) > 0 Then
Set rDate = Range("t_roulement[[Du]]").Find(CDate(Cells(kR, kCdu)), , xlValues, xlWhole)
If rDate Is Nothing Then
MsgBox "Anomalie: date " & Cells(kR, kCdu) & " non trouvée dans le tableau des roulements", , "Pour info"
Else
kCAbsent = Range("t_roulement[[Absents]]").Column
If Cells(rDate.Row, kCAbsent) = "" Then
Cells(rDate.Row, kCAbsent) = sNom
Else
If InStr(Cells(rDate.Row, kCAbsent), sNom) > 0 Then
'--- rien, déjà inscrit
Else
Cells(rDate.Row, kCAbsent) = Cells(rDate.Row, kCAbsent) & "; " & sNom
End If
kCNom = Range("t_roulement[[" & sNom & "]]").Column
Cells(rDate.Row, kCNom) = "a"
End If
End If
Set rDate = Nothing
End If
End If
End Sub |
