Re : ligne de couleur pour cellule active
j'ai trouver mon bonheur
Private Sub Worksheet_SelectionChanges ()
Set champ = [a1:l500]
col1 = champ.Column
col2 = champ.Column + champ.Columns.Count - 1
lig1 = champ.Row
lig2 = champ.Row + champ.Rows.Count - 1
For Each n In ActiveWorkbook.Names
If n.Name = "mémoNcol" Then trouvé = True
Next n
If trouvé Then
'---- restitution des couleurs
For i = 1 To [mémoNCol]
x = "mémoAdrCol" & i
a = Evaluate([x])
x = "mémoCoulCol" & i
b = Evaluate([x])
Range(a).Interior.ColorIndex = b
Next i
For i = 1 To [mémoNlig]
x = "mémoAdrLig" & i
a = Evaluate([x])
x = "mémoCoulLig" & i
b = Evaluate([x])
Range(a).Interior.ColorIndex = b
Next i
End If
'--- mémorisation des couleurs --------------------------
If Not Intersect(champ, Target) Is Nothing And Target.Count = 1 Then
ncol = col2 - col1 + 1
ActiveWorkbook.Names.Add Name:="mémoNcol", RefersToR1C1:= _
"=" & Chr(34) & ncol & Chr(34)
For i = 1 To ncol
ActiveWorkbook.Names.Add Name:="mémoAdrCol" & i, RefersToR1C1:= _
"=" & Chr(34) & Cells(Target.Row, i + col1 - 1).Address & Chr(34)
ActiveWorkbook.Names.Add Name:="mémoCoulCol" & i, RefersToR1C1:= _
"=" & Cells(Target.Row, i + col1 - 1).Interior.ColorIndex
Next i
'--
nlig = lig2 - lig1 + 1
ActiveWorkbook.Names.Add Name:="mémoNlig", RefersToR1C1:= _
"=" & Chr(34) & nlig & Chr(34)
For i = 1 To nlig
ActiveWorkbook.Names.Add Name:="mémoAdrLig" & i, RefersToR1C1:= _
"=" & Chr(34) & Cells(i + lig1 - 1, Target.Column).Address & Chr(34)
ActiveWorkbook.Names.Add Name:="mémoCoulLig" & i, RefersToR1C1:= _
"=" & Cells(i + lig1 - 1, Target.Column).Interior.ColorIndex
Cells(i + lig1 - 1, Target.Column).Interior.ColorIndex = 36
Next i
For i = 1 To ncol: Cells(Target.Row, i + col1 - 1).Interior.ColorIndex = 36: Next i
End If
End Sub
mais quand je la lance il y a :
"If Not Intersect(champ, Target) Is Nothing And Target.Count = 1 Then"
qui se met en erreur pourquoi