OVH Cloud OVH Cloud

sélection ligne active

6 réponses
Avatar
jack
Bonjour à tous, le 12 aout dernier j'ai reçu ce code qui fonctionne très bien.
le seul problème c'est que ma feuille contient déjà beaucoup de couleur
différente pour identifier des sections spécifiques. est-ce qu'il y aurait
une façon de conserver les couleurs d'origine après le déplacement d'une
cellule à l'autre.

merci



Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Cells.Rows.Interior.ColorIndex = xlNone
Target.EntireRow.Interior.ColorIndex = 24
End Sub

6 réponses

Avatar
isabelle
bonjour jack,

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Rows.Interior.ColorIndex = xlNone Then
Target.EntireRow.Interior.ColorIndex = 24
End If
End Sub

isabelle


Bonjour à tous, le 12 aout dernier j'ai reçu ce code qui fonctionne très bien.
le seul problème c'est que ma feuille contient déjà beaucoup de couleur
différente pour identifier des sections spécifiques. est-ce qu'il y aurait
une façon de conserver les couleurs d'origine après le déplacement d'une
cellule à l'autre.

merci



Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Cells.Rows.Interior.ColorIndex = xlNone
Target.EntireRow.Interior.ColorIndex = 24
End Sub



Avatar
LSteph
Bonsoir Jack,
(j'entends déjà siffler les scuds mais ce truc semble fonctionner)

'***dans module standard
Public arracol As New Collection, lastSel As String

'***dans le code feuille:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Dim c As Range
Dim i As Long

If Not lastSel = "" Then
For Each c In Range(lastSel).Cells
c.Interior.ColorIndex = arracol.Item(i + 1)
i = i + 1
Next c
End If
Do While arracol.Count > 0
arracol.Remove (1)
Loop
For i = 0 To Target.Cells.Count - 1

arracol.Add Target.Cells(i + 1).Interior.ColorIndex, CStr(i)
Next i
Target.Interior.ColorIndex = 24
lastSel = Target.Address
End Sub
'***
'lSteph


"jack" a écrit dans le message de news:

Bonjour à tous, le 12 aout dernier j'ai reçu ce code qui fonctionne très
bien.
le seul problème c'est que ma feuille contient déjà beaucoup de couleur
différente pour identifier des sections spécifiques. est-ce qu'il y aurait
une façon de conserver les couleurs d'origine après le déplacement d'une
cellule à l'autre.

merci



Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Cells.Rows.Interior.ColorIndex = xlNone
Target.EntireRow.Interior.ColorIndex = 24
End Sub



Avatar
Modeste
Bonsour®
est-ce qu'il y aurait une façon de conserver les
couleurs d'origine après le déplacement d'une cellule à l'autre.


une alternative qui ne touche aucunement aux couleurs d'origine ...
http://polykromy.com/fichiers/rectangle.xls


--
n'oubliez pas les FAQ :
http://www.excelabo.net http://dj.joss.free.fr/faq.htm
http://www.faqoe.com http://faqword.free.fr
--
Feed Back
http://viadresse.com/?94912042

Avatar
LSteph
Bonjour,
En fait pour la ligne entière j'avais zappé, donc ceci:

'***dans module standard**
Public arracol As New Collection, lastSel As String

'****dans le code feuille***
Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Dim c As Range
Dim i As Long
Dim that As String
Application.ScreenUpdating = False
Application.EnableEvents = False
that = Target.Address
Target.EntireRow.Select
Application.EnableEvents = True

If Not lastSel = "" Then
For Each c In Range(lastSel).Cells
c.Interior.ColorIndex = arracol.Item(i + 1)
i = i + 1
Next c
End If
Do While arracol.Count > 0
arracol.Remove (1)
Loop
For i = 0 To Selection.Cells.Count - 1

arracol.Add Selection.Cells(i + 1).Interior.ColorIndex, CStr(i)
Next i
Selection.Interior.ColorIndex = 24
lastSel = Selection.Address
Application.EnableEvents = False
Range(that).Select
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub

'****

'lSteph


"jack" a écrit dans le message de news:

Bonjour à tous, le 12 aout dernier j'ai reçu ce code qui fonctionne très
bien.
le seul problème c'est que ma feuille contient déjà beaucoup de couleur
différente pour identifier des sections spécifiques. est-ce qu'il y aurait
une façon de conserver les couleurs d'origine après le déplacement d'une
cellule à l'autre.

merci



Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Cells.Rows.Interior.ColorIndex = xlNone
Target.EntireRow.Interior.ColorIndex = 24
End Sub



Avatar
jack
Bonjour votre code fonctionne très bien. Par contre je ne suis plus capable
de faire des copier coller et il faut absolument que j'aie accès à cette
fonction.

Merci


Bonjour,
En fait pour la ligne entière j'avais zappé, donc ceci:

'***dans module standard**
Public arracol As New Collection, lastSel As String

'****dans le code feuille***
Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Dim c As Range
Dim i As Long
Dim that As String
Application.ScreenUpdating = False
Application.EnableEvents = False
that = Target.Address
Target.EntireRow.Select
Application.EnableEvents = True

If Not lastSel = "" Then
For Each c In Range(lastSel).Cells
c.Interior.ColorIndex = arracol.Item(i + 1)
i = i + 1
Next c
End If
Do While arracol.Count > 0
arracol.Remove (1)
Loop
For i = 0 To Selection.Cells.Count - 1

arracol.Add Selection.Cells(i + 1).Interior.ColorIndex, CStr(i)
Next i
Selection.Interior.ColorIndex = 24
lastSel = Selection.Address
Application.EnableEvents = False
Range(that).Select
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub

'****

'lSteph


"jack" a écrit dans le message de news:

Bonjour à tous, le 12 aout dernier j'ai reçu ce code qui fonctionne très
bien.
le seul problème c'est que ma feuille contient déjà beaucoup de couleur
différente pour identifier des sections spécifiques. est-ce qu'il y aurait
une façon de conserver les couleurs d'origine après le déplacement d'une
cellule à l'autre.

merci



Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Cells.Rows.Interior.ColorIndex = xlNone
Target.EntireRow.Interior.ColorIndex = 24
End Sub








Avatar
LSteph
Bonjour,

Non finalement il n'est pas bien!

Effectivement, pas pensé que cela érase le presse papier d'où pb du copier
coller
et de plus, il faudrait stocker la collection et la variable pour les
réutiliser à l'ouverture du classeur
car à défaut, la dernière ligne de sélection conserve malheureusement cette
fois sa coloration.
Tout cela devient bien lourd ! Donc à moins qu'il me vienne une meilleure
idée, désolé!

Sinon,
Je n'avais pas vu la suggestion de Modeste quand j'ai envoyé, celle ci
devrait répondre au besoin
et de façon plus simple.

A bientôt.

lSteph




"jack" a écrit dans le message de news:

Bonjour votre code fonctionne très bien. Par contre je ne suis plus
capable
de faire des copier coller et il faut absolument que j'aie accès à cette
fonction.

Merci


Bonjour,
En fait pour la ligne entière j'avais zappé, donc ceci:

'***dans module standard**
Public arracol As New Collection, lastSel As String

'****dans le code feuille***
Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Dim c As Range
Dim i As Long
Dim that As String
Application.ScreenUpdating = False
Application.EnableEvents = False
that = Target.Address
Target.EntireRow.Select
Application.EnableEvents = True

If Not lastSel = "" Then
For Each c In Range(lastSel).Cells
c.Interior.ColorIndex = arracol.Item(i + 1)
i = i + 1
Next c
End If
Do While arracol.Count > 0
arracol.Remove (1)
Loop
For i = 0 To Selection.Cells.Count - 1

arracol.Add Selection.Cells(i + 1).Interior.ColorIndex, CStr(i)
Next i
Selection.Interior.ColorIndex = 24
lastSel = Selection.Address
Application.EnableEvents = False
Range(that).Select
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub

'****

'lSteph


"jack" a écrit dans le message de news:

Bonjour à tous, le 12 aout dernier j'ai reçu ce code qui fonctionne
très
bien.
le seul problème c'est que ma feuille contient déjà beaucoup de couleur
différente pour identifier des sections spécifiques. est-ce qu'il y
aurait
une façon de conserver les couleurs d'origine après le déplacement
d'une
cellule à l'autre.

merci



Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Cells.Rows.Interior.ColorIndex = xlNone
Target.EntireRow.Interior.ColorIndex = 24
End Sub