XL 2013 Surlignage ligne et colone par clic

  • Initiateur de la discussion Initiateur de la discussion nicroq
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

nicroq

XLDnaute Occasionnel
Bonjour a tous,

Voici le code que j'ai complété afin de surligner la ligne et la colonne de la cellule sur laquelle je clique .
Cependant ma problématique est la suivante : est il possible de ne pas surligner l'ensemble de la ligne ou de la colonne mais uniquement dans un zone définie (voir fichier joint feuille 2 si je clique sur K17). Le code est actif en feuille 1.

En vous remerciant par avance
Cordialement


'Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
Application.ScreenUpdating = False
' Clear the color of all the cells
Cells.Interior.ColorIndex = 0
With Target
' Highlight the entire row and column that contain the active cell
.EntireRow.Interior.ColorIndex = 8
.EntireColumn.Interior.ColorIndex = 8
End With
Application.ScreenUpdating = True
'End Sub
 

Pièces jointes

Bonjour Nicroq,
Un essai en PJ, j'ai gardé la même structure que votre macro mais limité l'action de Change à la zone demandée.
VB:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Cells.Count > 1 Then Exit Sub
    If Not Intersect(Target, Range("E4:O25")) Is Nothing Then
        Application.ScreenUpdating = False
        ' Clear the color of all the cells
        Cells.Interior.ColorIndex = 0
        ' Highlight the entire row and column that contain the active cell
        Range(Cells(Target.Row, 5), Cells(Target.Row, 15)).Interior.ColorIndex = 8
        Range(Cells(4, Target.Column), Cells(25, Target.Column)).Interior.ColorIndex = 8
    End If
    Application.ScreenUpdating = True
End Sub
( utilisez les balises ( </> pour le code, c'est plus lisible )
 

Pièces jointes

Bonjour,
Dans votre fichier je pense que le zoom est de 0.001% ! 🙂
J'ai essayé votre solution, c'est très désagréable car en zoomant les cellules en B ça change automatiquement la hauteur de la ligne et ça fait un effet visuel gênant, comme un petit flash.
Une autre possibilité est de mettre les cellules en couleurs, ce qui revient au même pour les repérer mais qui ne touche pas à la hauteur des lignes.
Un essai en PJ.
 

Pièces jointes

Bonjour,
en effet je comprend l'effet qui peut etre genant... cela est deja tres bien de pouvoir surligner pour reperer mais dans mon fichier original qui comporte plus de date et plus de tache (colonneB) la taille des cellules est donc d'autant plus petite et je cherche donc une solution pour vraiment bien faire apparaitre en plus gros les cellules que vous avez mis en couleur violette.
Auriez vous une autre solution pour repondre à mon probleme?
merci d'avance
 
Salut,

Pour compléter la proposition de Sylvanu :
Une méthode en plus est de faire apparaitre un commentaire :
VB:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    If Target.Cells.Count > 1 Then Exit Sub
    If Not Intersect(Target, Range("E4:O25")) Is Nothing Then
        Application.ScreenUpdating = False
        ' Clear the color of all the cells
        Cells.Interior.ColorIndex = 0
        Cells.ClearComments
        ' Highlight the entire row and column that contain the active cell
        Range(Cells(Target.Row, 5), Cells(Target.Row, Target.Column)).Interior.ColorIndex = 8
        Range(Cells(4, Target.Column), Cells(Target.Row, Target.Column)).Interior.ColorIndex = 8
        ' Highlight the cells of Col B & Line 2
        Set_Comment Cells(2, Target.Column)
        Set_Comment Cells(Target.Row, 2)
    End If
    Application.ScreenUpdating = True
End Sub
Sub Set_Comment(Cell As Range)
    Cell.Interior.Color = RGB(255, 100, 255)
    With Cell.AddComment(Cell.Text).Shape
        .TextFrame.HorizontalAlignment = xlCenter
        .TextFrame.VerticalAlignment = xlCenter
        .DrawingObject.Font.Name = "Tahoma"
        .DrawingObject.Font.Bold = True
        .DrawingObject.Font.Size = 14
        .Visible = msoTrue
    End With
End Sub
 
Fanch, les commentaires ne s'effacent pas donc ils s'accumulent.

Sur Excel 2016, les commentaires s’effacent

Comment.gif
 
A essayer :
VB:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    If Target.Cells.Count > 1 Then Exit Sub
    
    Rows(2).ClearComments               'Effacer commentaires ligne 2
    Rows(2).Interior.ColorIndex = 0     'Effacer couleurs ligne 2
    
    Columns(2).ClearComments            'Effacer commentaires colonne 2
    Columns(2).Interior.ColorIndex = 0  'Effacer couleurs colonne 2
    
    [E4:O25].Interior.ColorIndex = 0    'Effacer couleurs cadre
    
    If Not Intersect(Target, Range("E4:O25")) Is Nothing Then
        Application.ScreenUpdating = False
        ' Highlight the entire row and column that contain the active cell
        Range(Cells(Target.Row, 5), Cells(Target.Row, Target.Column)).Interior.ColorIndex = 8
        Range(Cells(4, Target.Column), Cells(Target.Row, Target.Column)).Interior.ColorIndex = 8
        ' Highlight the cells of Col B & Line 2
        Set_Comment Cells(2, Target.Column)
        Set_Comment Cells(Target.Row, 2)
    End If
   
End Sub

Sub Set_Comment(Cell As Range)
    Cell.Interior.Color = RGB(255, 100, 255)        ' Couleur cellule
    With Cell.AddComment(Cell.Text).Shape
        .TextFrame.HorizontalAlignment = xlCenter   ' Alignement horizontal du commentaire
        .TextFrame.VerticalAlignment = xlCenter     ' Alignement vertical du commentaire
        .Fill.ForeColor.RGB = RGB(255, 100, 255)    ' Couleur de fond du commentaire
        .DrawingObject.Font.Name = "Tahoma"         ' Nom de la Police utilisée
        .DrawingObject.Font.Bold = True             ' Police en Gras
        .DrawingObject.Font.Size = 14               ' Taille Police
        .Visible = msoTrue                          ' Pour forcer l'affichage du commentaire
    End With
End Sub

Pour choisir une autre couleur :
 
Dernière édition:
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
2
Affichages
597
Réponses
1
Affichages
873
Réponses
0
Affichages
1 K
Retour