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

Le
François
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
Vidéos High-Tech et Jeu Vidéo
Téléchargements
Vos réponses
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
Philippe.R
Le #4675851
Bonjour,
En remplaçant Target par ActiveCell dans Target.Column Mod 2 = 1, ça
fonctionne mieux ?
--
Avec plaisir
Philippe.R
"François" news:
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) 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) 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



François
Le #4675801
Bonjour,

Effectivement, cela change tout !

Merci beaucoup

François

"Philippe.R"
Bonjour,
En remplaçant Target par ActiveCell dans Target.Column Mod 2 = 1, ça
fonctionne mieux ?
--
Avec plaisir
Philippe.R
"François" news:
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) 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) 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






Publicité
Poster une réponse
Anonyme