Dim zSaisie, NbNiv
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Set zSaisie = Range("B2:G10")
NbNiv = 4
If Not Intersect(zSaisie, Target) Is Nothing And Target.Count = 1 Then
NbLig = [Tableau1].Rows.Count
Dim TblBD(): ReDim TblBD(1 To NbLig, 1 To 2)
Dim TblBD2(): ReDim TblBD2(1 To NbLig, 1 To 10)
For i = 1 To NbLig
TblBD(i, 1) = [Tableau1].Item(i, 1)
TblBD(i, 2) = [Tableau1].Item(i, 1).IndentLevel + 1
Next i
Dim col(1 To 10)
nivprec = 10
For i = 1 To NbLig
niv = TblBD(i, 2)
If niv < nivprec Then col(niv) = TblBD(i, 1)
TblBD2(i, niv) = TblBD(i, 1)
For k = 1 To niv
TblBD2(i, k) = col(k)
Next k
Next i
Set d1 = CreateObject("Scripting.Dictionary")
nivCourant = Target.Column - zSaisie.Column + 1
Dim Tmp(): ReDim Tmp(1 To nivCourant)
For k = 1 To nivCourant - 1
Tmp(k) = Target.Offset(, -(nivCourant - k))
Next k
For i = 1 To UBound(TblBD2)
témoin = True
For k = 1 To nivCourant - 1
If TblBD2(i, k) <> Tmp(k) Then témoin = False
Next k
If témoin Then d1(TblBD2(i, nivCourant)) = ""
Next i
If d1.Count > 0 Then
temp = Join(d1.keys, ",")
Target.Validation.Delete
If temp <> "" Then Target.Validation.Add xlValidateList, Formula1:=temp
End If
End If
End Sub