Microsoft 365 Surligner plusieurs lignes sélectionnées avec Ctrl

[Claudy]

Bonjour à tous,
dans un classeur, j'ai cette procédure qui marche très bien pour une ligne sélectionnée:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Dim champ As Range

Dim col1 As Double

Dim col2 As Double

Set champ = Range("A2:K133000")

If Not Intersect(Range("A2:N133000"), Target) Is Nothing And Target.Count = 1 Then

champ.Interior.ColorIndex = xlNone

col1 = champ.Column

col2 = col1 + champ.Columns.Count - 1

Range(Cells(Target.Row, col1), Cells(Target.Row, col2)).Interior.ColorIndex = 36

End If

End Sub

Ma question: comment adapter ce code pour plusieurs lignes sélectionnées avec Ctrl ?

Merci d'avance,

Claudy

 

[Hasco]

Bonjour,

Peut-être en changeant la ligne

Range(Cells(Target.Row, col1), Cells(Target.Row, col2)).Interior.ColorIndex = 36

Par

Range(Cells(Target.Row, col1), Cells(Target.Row, col2)).Resize(Target.Rows.Count).Interior.ColorIndex = 36

Bonne chance

 

[Claudy]

Bonjour,

Peut-être en changeant la ligne

Range(Cells(Target.Row, col1), Cells(Target.Row, col2)).Interior.ColorIndex = 36

Par

Range(Cells(Target.Row, col1), Cells(Target.Row, col2)).Resize(Target.Rows.Count).Interior.ColorIndex = 36

Bonne chance

Bonsoir et merci,

mais je n'y voit aucun changement!

A+

Claudy

 

[Hasco]

Re,

Vous l'avez changé par celle-ci?:

Range(Cells(Target.Row, col1), Cells(Target.Row, col2)).Resize(Target.Rows.Count).Interior.ColorIndex = 36

Si cela ne va pas Changez .Resize(Target.Rows.Count) par .Resize(Selection.Rows.Count)

Et si cela ne va toujours pas et ben reste plus qu'à attendre patiemment que quelqu'un tape juste ou que vous joignez un fichier exemple avec la macro à modifier et tout le toutim

A+ ou pas

 

[Claudy]

Re,

Vous l'avez changé par celle-ci?:

Range(Cells(Target.Row, col1), Cells(Target.Row, col2)).Resize(Target.Rows.Count).Interior.ColorIndex = 36

Si cela ne va pas Changez .Resize(Target.Rows.Count) par .Resize(Selection.Rows.Count)

Et si cela ne va toujours pas et ben reste plus qu'à attendre patiemment que quelqu'un tape juste ou que vous joignez un fichier exemple avec la macro à modifier et tout le toutim

A+ ou pas

Re,
oui j'ai changé, modifié...et ça va toujours pas!

Fichier joint.

Merci

Claudy

 

[Hasco]

Re,

Voir cette macro dans fichier joint:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim Tout As Range, Part As Range
    Set Tout = Range("A2:N133")
    If Not Intersect(Tout, Target) Is Nothing Then
        Set Part = Range("A2:K133")
        Part.Interior.ColorIndex = xlNone
        Intersect(Part, Target.EntireRow).Interior.ColorIndex = 36
    End If
End Sub

Bonne soirée

 

[job75]

Bonjour Claudy, Roblochon,

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim champ As Range, a As Range
Set champ = Range("A2:K133")
If Intersect(champ, Target) Is Nothing Then Exit Sub
champ.Interior.ColorIndex = xlNone
For Each a In Intersect(Target.EntireRow, champ).Areas
    a.Interior.ColorIndex = 36
Next
End Sub

A+

 

[Claudy]

OK, merci, super et bonne soirée,
Claudy