Dim h1 As Byte 'mémorise la variable
Sub ZoneTexteClic()
Dim lig As Long, tableau As Range, cel As Range, col As Variant
On Error Resume Next 'sécurité
lig = Application.Match(Replace(Application.Caller, "_", " "), [A:A], 0) + 3
Set tableau = Evaluate(ThisWorkbook.Names(Application.Caller).RefersTo)
For Each cel In Cells(lig, 1).Resize(, 31)
If IsDate(cel) Then
col = Application.Match(cel, tableau.Offset(-2).Rows(1), 0)
Tirage cel, tableau.Columns(col)
End If
Next
Application.Calculation = xlCalculationAutomatic
End Sub
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not IsDate(Target) Then Exit Sub
Dim tableau As Range, col As Byte
Cancel = True
On Error Resume Next 'sécurité
Set tableau = Evaluate(ThisWorkbook.Names(Replace(Cells(Target.Row - 3, 1), " ", "_")).RefersTo)
col = Application.Match(Target, tableau.Offset(-2).Rows(1), 0)
Tirage Target, tableau.Columns(col)
Application.Calculation = xlCalculationAutomatic
End Sub
Sub Tirage(cel As Range, tableau As Range)
Dim plage As Range, h2 As Byte
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Set plage = cel(2).Resize(tableau.Rows.Count)
plage = tableau.Value
plage.Insert xlToRight
With plage.Offset(, -1)
.FormulaR1C1 = "=IF(RC[1]<>"""",RAND())"
.Resize(, 2).Sort .Columns, xlAscending, Header:=xlNo
.Delete xlToLeft
End With
h1 = IIf(h1 = 3, 4, 3)
h2 = IIf(h1 = 3, 4, 3)
plage.Interior.ColorIndex = xlNone 'RAZ
plage(1).Interior.Color = Cells(cel.Row - 2, "F").Interior.Color
plage(2).Resize(h1).Interior.Color = Cells(cel.Row - 2, "H").Interior.Color
plage(2 + h1).Resize(h2).Interior.Color = Cells(cel.Row - 2, "J").Interior.Color
End Sub