Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Source As Range)
If InStr("L4L10L16L22L28", Source.Address(0, 0)) = 0 Then Exit Sub
If InStr(Source, vbLf) = 0 Then Exit Sub 'date délimitée par le saut de ligne
Dim dat$, tablo$(), i&
dat = Left(Source, InStr(Source, vbLf) - 1)
If Not IsDate(dat) Then Exit Sub
ReDim tablo(Int(Len(Source) / 255), 0) '255 caractères par élément
For i = 0 To UBound(tablo)
tablo(i, 0) = Mid(Source, 255 * i + 1, 255)
Next
ThisWorkbook.Names.Add UCase(Format(CDate(dat), "mmmm_yyyy_dd")), tablo
End Sub
Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, _
ByVal Target As Range, cancel As Boolean)
If Intersect(Target, Sh.[C4:I9]) Is Nothing Then Exit Sub
Dim cel As Range
cancel = True
For Each cel In Intersect(Target.EntireRow, Sh.[C:G])
Affiche Sh, cel
Next
If Weekday(Target, 2) > 5 Then Exit Sub 'week-end exclu
Sh.[L4:L28].Cells(6 * Weekday(Target, 2) - 5).Select
SendKeys "{F2}" 'touche F2
End Sub
Sub Affiche(Sh As Object, cel As Range)
Dim t, txt$
On Error Resume Next 'si le nom n'est pas encore défini
For Each t In Evaluate(Format(cel, "mmmm_yyyy_dd"))
txt = txt & t 'concatène les éléments du tableau
Next
Sh.[L4:L28].Cells(6 * Weekday(cel, 2) - 5) _
= IIf(txt = "", Format(cel, "dd/mm/yyyy") & vbLf, txt)
End Sub