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

Claudy

XLDnaute Accro
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

XLDnaute Barbatruc
Repose en paix
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
 

Hasco

XLDnaute Barbatruc
Repose en paix
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 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
Re,
oui j'ai changé, modifié...et ça va toujours pas!

Fichier joint.

Merci

Claudy
 

Pièces jointes

  • testclaudy.xlsm
    17.7 KB · Affichages: 3

Hasco

XLDnaute Barbatruc
Repose en paix
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
 

Pièces jointes

  • testclaudy.xlsm
    15 KB · Affichages: 4

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

Statistiques des forums

Discussions
311 725
Messages
2 081 940
Membres
101 845
dernier inscrit
annesof