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

Claudy

XLDnaute Impliqué
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
 

Roblochon

XLDnaute Accro
Bonjour,

Peut-être en changeant la ligne
Code:
Range(Cells(Target.Row, col1), Cells(Target.Row, col2)).Interior.ColorIndex = 36
Par
VB:
Range(Cells(Target.Row, col1), Cells(Target.Row, col2)).Resize(Target.Rows.Count).Interior.ColorIndex = 36

Bonne chance
 

Claudy

XLDnaute Impliqué
Bonjour,

Peut-être en changeant la ligne
Code:
Range(Cells(Target.Row, col1), Cells(Target.Row, col2)).Interior.ColorIndex = 36
Par
VB:
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
 

Roblochon

XLDnaute Accro
Re,

Vous l'avez changé par celle-ci?:
VB:
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

XLDnaute Impliqué
Re,

Vous l'avez changé par celle-ci?:
VB:
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
 

Fichiers joints

Roblochon

XLDnaute Accro
Re,

Voir cette macro dans fichier joint:
VB:
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
 

Fichiers joints

job75

XLDnaute Barbatruc
Bonjour Claudy, Roblochon,
VB:
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+
 

Discussions similaires


Haut Bas