Bonjour à tous,
Petite question, j'ai récupéré le code ci-dessous, depuis ce site : http://boisgontierjacques.free.fr/, que j'ai adapté à mon beosin. Tout fonctionne correctement, mis à part que dans mon cas j'ai besoin de renseigner dans les cellules de nouvelles valeurs, le problème c'est qu'il y a une restriction sur les valeurs que peut prendre une cellule.
Est-il possible d'enlever cette restriction?
D'avance merci,
Petite question, j'ai récupéré le code ci-dessous, depuis ce site : http://boisgontierjacques.free.fr/, que j'ai adapté à mon beosin. Tout fonctionne correctement, mis à part que dans mon cas j'ai besoin de renseigner dans les cellules de nouvelles valeurs, le problème c'est qu'il y a une restriction sur les valeurs que peut prendre une cellule.
Est-il possible d'enlever cette restriction?
D'avance merci,
VB:
im zSaisie, NbNiv
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Set zSaisie = Range("E2:H5000") ' adapter
NbNiv = 4 ' adapter
If Not Intersect(zSaisie, Target) Is Nothing And Target.Count = 1 Then
TblMap = [Table1].Value
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(TblMap)
témoin = True
For k = 1 To nivCourant - 1
If TblMap(i, k) <> Tmp(k) Then témoin = False: Exit For
Next k
If témoin Then d1(TblMap(i, nivCourant)) = ""
Next i
If d1.Count > 0 Then
Target.Validation.Delete
Set Rng = [O2].Resize(d1.Count) ' adapter K2
Rng.Resize(100).ClearContents
Rng.Value = Application.Transpose(d1.keys)
Target.Validation.Add xlValidateList, Formula1:="=" & Rng.Address
End If
End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(zSaisie, Target) Is Nothing And Target.Count = 1 Then
nivCourant = Target.Column - zSaisie.Column + 1
If nivCourant < NbNiv Then
Application.EnableEvents = False
Target.Offset(, 1).Resize(, NbNiv - nivCourant).Validation.Delete
Target.Offset(, 1).Resize(, NbNiv - nivCourant) = ""
Application.EnableEvents = True
End If
End If
End Sub