Problème pour exploiter l'affichage automatique de validation de JB

Bonjour à tous,

J'essaie d'exploiter l'affichage automatique du menu de validation (proposé
par JB sur son site) en Worksheet_SelectionChange.
Dans mon fichier, les cellules concernées sont toutes les cellules du
tableau A5:N64, mais seulement pour les colonnes impaires (donc A, C, E )
ce qui me donne :

If Not Intersect([A5:N64], Target) Is Nothing And Target.Column Mod 2 = 1
Then
SendKeys "%{DOWN}"
End If

Par ailleurs, les cellules des colonnes impaires ont toutes une même macro
en Worksheet_Change, et celle des colonnes paires une autre (dont le contenu
est écrit ci-après).

Le problème :
si je sélectionne C10 par exemple, l'affichage du menu de validation se fait
bien
quand je sélectionne une valeur, la macro évènementielle liée à C10 se fait
bien et la cellule de droite est bien sélectionnée en fin de la macro
mais pour cette nouvelle cellule (D10), le menu de validation de cette
nouvelle cellule s'affiche alors que je ne le souhaite pas
- je pensais que l'instruction "Target.Column Mod 2 = 1" mise en
selection_change le permettrait !

Comment remédier à ce problème ?

Merci pour votre aide

François


Private Sub Worksheet_Change(ByVal Target As Range)

If Not Intersect(Target, Range(Range("ChampMFC1"))) Is Nothing And
Target.Count = 1 And Not temoin Then
temoin = True
Range("couleursMFC").Cells(1, 1).Copy
Target.PasteSpecial Paste:=xlPasteFormats
For Each c In Range("couleursMFC")
If Target.Value = c.Value Then
c.Copy
Target.PasteSpecial Paste:=xlPasteFormats
Target.Offset(0, 1).PasteSpecial Paste:=xlPasteFormats
Range(Target, Target.Offset(0, 1)).Select
With Selection
.Borders(xlInsideVertical).LineStyle = xlNone
.Borders(xlEdgeLeft).LineStyle = xlContinuous
.Borders(xlEdgeTop).LineStyle = xlContinuous
.Borders(xlEdgeBottom).LineStyle = xlContinuous
.Borders(xlEdgeRight).LineStyle = xlContinuous
End With
End If
Next c
i = 1
While IsNumeric(Target.Offset(-i)) = False
i = i + 1
Wend
valeur = Target.Offset(-i).Value
If valeur = 0 Then
i = 1
While IsDate(Target.Offset(-i)) = False
i = i + 1
Wend
valeur = Target.Offset(-i).Value
End If
j = 3
While Sheets(ActiveSheet.Name & ".list").Cells(j, 1).Value <>
Target.Value
j = j + 1
Wend
Sheets(ActiveSheet.Name & ".list").Cells(j, valeur + 1).Value = "X"
Application.CutCopyMode = False
temoin = False
Target.Offset(0, 1).Select
End If

If Not Intersect(Target, Range(Range("ChampMFC2"))) Is Nothing And
Target.Count = 1 And Not temoin Then
temoin = True
Range("couleursMFC").Cells(1, 1).Copy
Target.PasteSpecial Paste:=xlPasteFormats
For Each c In Range("couleursMFC")
If Target.Value = c.Value Then
c.Copy
Target.PasteSpecial Paste:=xlPasteFormats
Target.Offset(0, 1).PasteSpecial Paste:=xlPasteFormats
Range(Target, Target.Offset(0, 1)).Select
With Selection
.Borders(xlInsideVertical).LineStyle = xlNone
.Borders(xlEdgeLeft).LineStyle = xlContinuous
.Borders(xlEdgeTop).LineStyle = xlContinuous
.Borders(xlEdgeBottom).LineStyle = xlContinuous
.Borders(xlEdgeRight).LineStyle = xlContinuous
End With
End If
Next c
i = 1
While IsNumeric(Target.Offset(-i)) = False
i = i + 1
Wend
valeur = Target.Offset(-i).Value
If valeur = 0 Then
i = 1
While IsDate(Target.Offset(-i)) = False
i = i + 1
Wend
valeur = Target.Offset(-i).Value
End If
j = 3
While Sheets(ActiveSheet.Name & ".list").Cells(j, 1).Value <>
Target.Value
j = j + 1
Wend
Sheets(ActiveSheet.Name & ".list").Cells(j, valeur + 1).Value = "X"
Application.CutCopyMode = False
temoin = False
Target.Offset(0, 1).Select
End If

If Not Intersect(Target, Range(Range("Champ2MFC1"))) Is Nothing And
Target.Count = 1 And Not temoin Then
temoin = True
If Target.Value = "Cancel" Then
employe = Target.Offset(0, -1).Value
Range(Target, Target.Offset(0, -1)).Select
With Selection
.Borders(xlInsideVertical).LineStyle = xlNone
.Borders(xlEdgeLeft).LineStyle = xlContinuous
.Borders(xlEdgeTop).LineStyle = xlNone
.Borders(xlEdgeBottom).LineStyle = xlNone
.Borders(xlEdgeRight).LineStyle = xlContinuous
.Font.ColorIndex = 0
.Interior.ColorIndex = xlNone
.ClearContents
End With
i = 1
While IsNumeric(Target.Offset(-i, -1)) = False
i = i + 1
Wend
valeur = Target.Offset(-i, -1).Value
If valeur = 0 Then
i = 1
While IsDate(Target.Offset(-i, -1)) = False
i = i + 1
Wend
valeur = Target.Offset(-i, -1).Value
End If
j = 3
While Sheets(ActiveSheet.Name & ".list").Cells(j, 1).Value <>
employe
j = j + 1
Wend
Sheets(ActiveSheet.Name & ".list").Cells(j, valeur + 1).Value =
""
Else
For Each c In Range("couleurs2MFC")
If Target.Value = c.Value Then
c.Copy
employe = Target.Offset(0, -1).Value
If c.Offset(0, 1) <> "M" And c.Offset(0, 1) <> "C" And
c.Offset(0, 1) <> "S" Then
Target.PasteSpecial Paste:=xlPasteFormats
Target.Offset(0, -1).PasteSpecial
Paste:=xlPasteFormats
End If
Range(Target, Target.Offset(0, -1)).Select
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlContinuous
Selection.Borders(xlEdgeTop).LineStyle = xlContinuous
Selection.Borders(xlEdgeBottom).LineStyle = xlContinuous
Selection.Borders(xlEdgeRight).LineStyle = xlContinuous
If c.Offset(0, 1).Value <> "" Then
employe = Target.Offset(0, -1).Value
i = 1
While IsNumeric(Target.Offset(-i, -1)) = False
i = i + 1
Wend
valeur = Target.Offset(-i, -1).Value
If valeur = 0 Then
i = 1
While IsDate(Target.Offset(-i, -1)) = False
i = i + 1
Wend
valeur = Target.Offset(-i, -1).Value
End If
j = 3
While Sheets(ActiveSheet.Name & ".list").Cells(j,
1).Value <> employe
j = j + 1
Wend
Sheets(ActiveSheet.Name & ".list").Cells(j, valeur +
1).Value = c.Offset(0, 1).Value
If c.Offset(0, 1).Value = "M" Then
Sheets(ActiveSheet.Name & ".list").Cells(j,
valeur + 1).Font.ColorIndex = 5
ElseIf c.Offset(0, 1).Value = "T" Then
Sheets(ActiveSheet.Name & ".list").Cells(j,
valeur + 1).Font.ColorIndex = 10
ElseIf c.Offset(0, 1).Value = "T~" Then
Sheets(ActiveSheet.Name & ".list").Cells(j,
valeur + 1).Font.ColorIndex = 50
ElseIf c.Offset(0, 1).Value = "S" Then
Sheets(ActiveSheet.Name & ".list").Cells(j,
valeur + 1).Font.ColorIndex = 3
Else
Sheets(ActiveSheet.Name & ".list").Cells(j,
valeur + 1).Font.ColorIndex = 1
End If
End If
End If
Next c
End If
Target.Offset(1, 0).Select
Application.CutCopyMode = False
temoin = False
End If

If Not Intersect(Target, Range(Range("Champ2MFC2"))) Is Nothing And
Target.Count = 1 And Not temoin Then
temoin = True
If Target.Value = "Cancel" Then
employe = Target.Offset(0, -1).Value
Range(Target, Target.Offset(0, -1)).Select
With Selection
.Borders(xlInsideVertical).LineStyle = xlNone
.Borders(xlEdgeLeft).LineStyle = xlContinuous
.Borders(xlEdgeTop).LineStyle = xlNone
.Borders(xlEdgeBottom).LineStyle = xlNone
.Borders(xlEdgeRight).LineStyle = xlContinuous
.Font.ColorIndex = 0
.Interior.ColorIndex = xlNone
.ClearContents
End With
i = 1
While IsNumeric(Target.Offset(-i, -1)) = False
i = i + 1
Wend
valeur = Target.Offset(-i, -1).Value
If valeur = 0 Then
i = 1
While IsDate(Target.Offset(-i, -1)) = False
i = i + 1
Wend
valeur = Target.Offset(-i, -1).Value
End If
j = 3
While Sheets(ActiveSheet.Name & ".list").Cells(j, 1).Value <>
employe
j = j + 1
Wend
Sheets(ActiveSheet.Name & ".list").Cells(j, valeur + 1).Value =
""
Else
For Each c In Range("couleurs2MFC")
If Target.Value = c.Value Then
c.Copy
employe = Target.Offset(0, -1).Value
If c.Offset(0, 1) <> "M" And c.Offset(0, 1) <> "C" And
c.Offset(0, 1) <> "S" Then
Target.PasteSpecial Paste:=xlPasteFormats
Target.Offset(0, -1).PasteSpecial
Paste:=xlPasteFormats
End If
Range(Target, Target.Offset(0, -1)).Select
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlContinuous
Selection.Borders(xlEdgeTop).LineStyle = xlContinuous
Selection.Borders(xlEdgeBottom).LineStyle = xlContinuous
Selection.Borders(xlEdgeRight).LineStyle = xlContinuous
If c.Offset(0, 1).Value <> "" Then
employe = Target.Offset(0, -1).Value
i = 1
While IsNumeric(Target.Offset(-i, -1)) = False
i = i + 1
Wend
valeur = Target.Offset(-i, -1).Value
If valeur = 0 Then
i = 1
While IsDate(Target.Offset(-i, -1)) = False
i = i + 1
Wend
valeur = Target.Offset(-i, -1).Value
End If
j = 3
While Sheets(ActiveSheet.Name & ".list").Cells(j,
1).Value <> employe
j = j + 1
Wend
Sheets(ActiveSheet.Name & ".list").Cells(j, valeur +
1).Value = c.Offset(0, 1).Value
If c.Offset(0, 1).Value = "M" Then
Sheets(ActiveSheet.Name & ".list").Cells(j,
valeur + 1).Font.ColorIndex = 5
ElseIf c.Offset(0, 1).Value = "T" Then
Sheets(ActiveSheet.Name & ".list").Cells(j,
valeur + 1).Font.ColorIndex = 10
ElseIf c.Offset(0, 1).Value = "T~" Then
Sheets(ActiveSheet.Name & ".list").Cells(j,
valeur + 1).Font.ColorIndex = 50
ElseIf c.Offset(0, 1).Value = "S" Then
Sheets(ActiveSheet.Name & ".list").Cells(j,
valeur + 1).Font.ColorIndex = 3
Else
Sheets(ActiveSheet.Name & ".list").Cells(j,
valeur + 1).Font.ColorIndex = 1
End If
End If
End If
Next c
End If
Target.Offset(1, 0).Select
Application.CutCopyMode = False
temoin = False
End If

If Not Intersect(Target, Range("AJ1:AL1")) Is Nothing And Target.Count =
1 And Not temoin Then
temoin = True
For Each c In Range(Range("ChampFeries"))
If c <> "" Then
If Day(Target) = c Then
Range(Cells(c.Row + 1, c.Column), Cells(c.Row + 9,
c.Column + 1)).Select
With Selection
.ClearContents
.Borders(xlInsideVertical).LineStyle = xlNone
.Borders(xlInsideHorizontal).LineStyle = xlNone
.Interior.ColorIndex = xlNone
End With
Cells(c.Row + 2, c.Column + 1).Select
With Selection
.Value = "Holiday"
.HorizontalAlignment = xlRight
End With
Range(Cells(c.Row, c.Column), Cells(c.Row + 9, c.Column
+ 1)).Select
With Selection.Interior
.ColorIndex = 37
.Pattern = xlSolid
End With
End If
End If
Next c
Application.CutCopyMode = False
temoin = False
Range("A5").Select
End If

If Not Intersect(Target, Range("O5:O17")) Is Nothing And Target.Count =
1 And Not temoin Then
Application.ScreenUpdating = False ' it doesn't show all the
changements
temoin = True
Target.Copy
For c = 3 To 15
If Sheets(ActiveSheet.Name & ".list").Cells(c, 1).Value =
Target.Value Then
With Sheets(ActiveSheet.Name & ".list")
If .Cells(c, 1).Value = Target.Value Then
.Cells(c, 1).PasteSpecial Paste:=xlPasteFormats
.Cells(c, 1).Borders(xlEdgeLeft).Weight = xlMedium
End If
End With
End If
Next c
If ActiveSheet.Name = Left(Sheets("3 months list").Cells(1,
33).Value, 3) Then
For c = 2 To 14
If Sheets("3 months list").Cells(c, 1).Value = Target.Value
And c <> 15 And c <> 30 Then
With Sheets("3 months list")
If .Cells(c, 1).Value = Target.Value Then
.Cells(c, 1).PasteSpecial Paste:=xlPasteFormats
End If
End With
End If
Next c
End If
If ActiveSheet.Name = Left(Sheets("3 months list").Cells(16,
33).Value, 3) Then
For c = 17 To 29
If Sheets("3 months list").Cells(c, 1).Value = Target.Value
And c <> 15 And c <> 30 Then
With Sheets("3 months list")
If .Cells(c, 1).Value = Target.Value Then
.Cells(c, 1).PasteSpecial Paste:=xlPasteFormats
End If
End With
End If
Next c
End If
If ActiveSheet.Name = Left(Sheets("3 months list").Cells(31,
33).Value, 3) Then
For c = 32 To 44
If Sheets("3 months list").Cells(c, 1).Value = Target.Value
And c <> 15 And c <> 30 Then
With Sheets("3 months list")
If .Cells(c, 1).Value = Target.Value Then
.Cells(c, 1).PasteSpecial Paste:=xlPasteFormats
End If
End With
End If
Next c
End If
temoin = False
Application.CutCopyMode = False
Application.ScreenUpdating = True
End If

End Sub