XL 2013 Surlignage ligne et colone par clic

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

  • test surlignage.xlsm
    16.1 KB · Affichages: 22

sylvanu

XLDnaute Barbatruc
Supporter XLD
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

  • test surlignage(V2).xlsm
    20 KB · Affichages: 10

nicroq

XLDnaute Occasionnel
Bonsoir sylvanu
merci pr ta reponse c est top
cependant est il possible de ne pas avoir la partie après et en dessous du point en surbrillance?
comme en image dans le fichier joint si je clique sur L13.
MErci encore pour votre aide
 

Pièces jointes

  • test surlignage(V3).xlsm
    16.8 KB · Affichages: 6

nicroq

XLDnaute Occasionnel
Bonjour Sylvanu,
j'aurais une dernière requete!! serait possible de zoomer ou de grossir la cellule ds l'allignement de la row et de la colonne (dans l exemple ci joint la cellule B13 et L2)
Merci de votre retour

Cordialement
 

Pièces jointes

  • test surlignage(V4.xlsm
    17.4 KB · Affichages: 8

sylvanu

XLDnaute Barbatruc
Supporter XLD
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

  • test surlignage(V5).xlsm
    21 KB · Affichages: 10

nicroq

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

fanch55

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

fanch55

XLDnaute Barbatruc
Fanch, les commentaires ne s'effacent pas donc ils s'accumulent.

Sur Excel 2016, les commentaires s’effacent

Comment.gif
 

fanch55

XLDnaute Barbatruc
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:

Discussions similaires

Statistiques des forums

Discussions
312 079
Messages
2 085 129
Membres
102 788
dernier inscrit
Remy003