Problème pour exploiter l'affichage automatique de validation de JB
2 réponses
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
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire
Veuillez sélectionner un problème
Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
Philippe.R
Bonjour, En remplaçant Target par ActiveCell dans Target.Column Mod 2 = 1, ça fonctionne mieux ? -- Avec plaisir Philippe.R "François" a écrit dans le message de 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) <> "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
Bonjour,
En remplaçant Target par ActiveCell dans Target.Column Mod 2 = 1, ça
fonctionne mieux ?
--
Avec plaisir
Philippe.R
"François" <nospam@nospam.fr> a écrit dans le message de
news:e3djSQH7HHA.1444@TK2MSFTNGP05.phx.gbl...
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
Bonjour, En remplaçant Target par ActiveCell dans Target.Column Mod 2 = 1, ça fonctionne mieux ? -- Avec plaisir Philippe.R "François" a écrit dans le message de 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) <> "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
François
Bonjour,
Effectivement, cela change tout !
Merci beaucoup
François
"Philippe.R" <AS_rauphil_at_wanadoo.fr> a écrit dans le message de news:
Bonjour, En remplaçant Target par ActiveCell dans Target.Column Mod 2 = 1, ça fonctionne mieux ? -- Avec plaisir Philippe.R "François" a écrit dans le message de 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) <> "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
Bonjour,
Effectivement, cela change tout !
Merci beaucoup
François
"Philippe.R" <AS_rauphil_at_wanadoo.fr> a écrit dans le message de news:
eHcOtfH7HHA.4712@TK2MSFTNGP04.phx.gbl...
Bonjour,
En remplaçant Target par ActiveCell dans Target.Column Mod 2 = 1, ça
fonctionne mieux ?
--
Avec plaisir
Philippe.R
"François" <nospam@nospam.fr> a écrit dans le message de
news:e3djSQH7HHA.1444@TK2MSFTNGP05.phx.gbl...
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
"Philippe.R" <AS_rauphil_at_wanadoo.fr> a écrit dans le message de news:
Bonjour, En remplaçant Target par ActiveCell dans Target.Column Mod 2 = 1, ça fonctionne mieux ? -- Avec plaisir Philippe.R "François" a écrit dans le message de 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) <> "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