XL 2013 Surlignage ligne et colone par clic

nicroq · 2 Juin 2020

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

sylvanu · 2 Juin 2020

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 )

nicroq · 4 Juin 2020

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

sylvanu · 4 Juin 2020

Bonsoir,
Voilà.

nicroq · 4 Juin 2020

Parfait merci bcp! très reactif !!! c es ttop
bonne soirée

nicroq · 5 Juin 2020

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

sylvanu · 5 Juin 2020

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.

nicroq · 5 Juin 2020

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 · 5 Juin 2020

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

sylvanu · 5 Juin 2020

Bonjour le fil,
Fanch, les commentaires ne s'effacent pas donc ils s'accumulent.
Nicroq, un essai en PJ. Je trouve ça désagréable mais si la solution vous va ...

fanch55 · 5 Juin 2020

sylvanu à dit:
Fanch, les commentaires ne s'effacent pas donc ils s'accumulent.

Sur Excel 2016, les commentaires s’effacent

sylvanu · 5 Juin 2020

Oups, sorry.🙄
Sous 2007 l'effet est ci dessous.
Comme Nicroq est en 2013 juste au milieu de nous, avec un peu de chance, cela lui fera une solution supplémentaire.

sylvanu · 5 Juin 2020

Une autre approche :

Nicroq va avoir trop de solutions ! 😀

nicroq · 5 Juin 2020

ah ouai l'idee du commentaire est plutot sympa!
est il possible de la rendre plus jolie que ce rose pale ?
est il possible aussi d'annuler la subrillance et les commentaires lorsque je clique en dehors du cadre?

merci 🙂

fanch55 · 5 Juin 2020

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 :

Liste de 729 couleurs RGB

Liste de valeurs RGB avec les couleurs correspondantes utilisables pour vos développements ...

www.excel-pratique.com

XL 2013 Surlignage ligne et colone par clic

XLDnaute Occasionnel

Pièces jointes

XLDnaute Barbatruc

Pièces jointes

XLDnaute Occasionnel

Pièces jointes

XLDnaute Barbatruc

Pièces jointes

XLDnaute Occasionnel

XLDnaute Occasionnel

Pièces jointes

XLDnaute Barbatruc

Pièces jointes

XLDnaute Occasionnel

XLDnaute Barbatruc

XLDnaute Barbatruc

Pièces jointes

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

Pièces jointes

XLDnaute Occasionnel

XLDnaute Barbatruc

Discussions similaires

Privacy & Transparency

Privacy & Transparency