XL 2019 Colorer la partie d'entêtes d'un pavé de cellules selon clic-doit sur une cellule interne

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 !

Webperegrino

XLDnaute Accro
Supporter XLD
Bonjour Le Forum,
J'ai commencé de la programmation vba mais je coince...

Mon problème :
Comment colorer en orange la partie d'entêtes, en D7:J7 et B9:B15 si une cellule est sélectionnée à l'intérieur de la partie D9:J15 tout en conservant les couleurs dans cette dernière partie ?


Exemple :
Avec clic droit sur G12 qui est rouge :
- G12 reste en ROUGE
- G7 et B12 se colorient en orange.

Si on clique ailleurs :
- G7 et B12 redevient blanches (apparemment ce que j'ai mis en vba au début réalise cela par macro)
- G12 reste en rouge.

Merci pour vos lumières (pour les lignes VBA manquantes).
Webperegrino
 

Pièces jointes

Solution
Bonjour,

VB:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    Dim zoneDonnees As Range
    Dim enteteColonnes As Range
    Dim enteteLignes As Range

    Set zoneDonnees = Me.Range("D9:J15")
    Set enteteColonnes = Me.Range("D7:J7")
    Set enteteLignes = Me.Range("B9:B15")

    enteteColonnes.Interior.ColorIndex = xlNone
    enteteLignes.Interior.ColorIndex = xlNone

    If Not Intersect(Target, zoneDonnees) Is Nothing Then

        Me.Cells(7, Target.Column).Interior.Color = RGB(255, 192, 0)
        Me.Cells(Target.Row, 2).Interior.Color = RGB(255, 192, 0)

    End If

End Sub

Nicolas
(voisin très proche apparemment)
Bonjour,

VB:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    Dim zoneDonnees As Range
    Dim enteteColonnes As Range
    Dim enteteLignes As Range

    Set zoneDonnees = Me.Range("D9:J15")
    Set enteteColonnes = Me.Range("D7:J7")
    Set enteteLignes = Me.Range("B9:B15")

    enteteColonnes.Interior.ColorIndex = xlNone
    enteteLignes.Interior.ColorIndex = xlNone

    If Not Intersect(Target, zoneDonnees) Is Nothing Then

        Me.Cells(7, Target.Column).Interior.Color = RGB(255, 192, 0)
        Me.Cells(Target.Row, 2).Interior.Color = RGB(255, 192, 0)

    End If

End Sub

Nicolas
(voisin très proche apparemment)
 

Pièces jointes

Bonsoir Le Forum,
Bonsoir Monsieur JACQUIN,
"La rive droite du Blavet" vient d'expérimenter la proposition #2 : je constate que cela répond parfaitement à mes souhaits.
C'est parfait.
Il ne me reste plus qu'à placer une ligne de code pour éviter de voir la fenêtre parasite (ci-dessous) apparaître à chaque clic-droit sur les cellules du pavé.
Mais c'est déjà magique !
Merci beaucoup Nicolas,
Webperegrino
1769110869409.png
 
Bonsoir Le Forum,
Bonsoir Monsieur JACQUIN,
"La rive droite du Blavet" vient d'expérimenter la proposition #2 : je constate que cela répond parfaitement à mes souhaits.
C'est parfait.
Il ne me reste plus qu'à placer une ligne de code pour éviter de voir la fenêtre parasite (ci-dessous) apparaître à chaque clic-droit sur les cellules du pavé.
Mais c'est déjà magique !
Merci beaucoup Nicolas,
Webperegrino
Regarde la pièce jointe 1226933

A rajouter:
VB:
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)

    If Not Intersect(Target, Me.Range("B9:J15")) Is Nothing Then
        Cancel = True   ' empêche le menu contextuel
    End If

End Sub
 

Pièces jointes

Le Forum, Nicolas,
En plaçant Cancel=True dans le corps de macro, mais en commençant par ...
VB:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
... au lieu de
VB:
'Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
... cela fonctionne à merveille !

Ainsi, c'est génial car :
- en cliquant dans le pavé des couleurs la mise en couleur d'entête de croisement ligne-colonne sur cellule se fait
- ET SURTOUT, la mise en blanc des entêtes par clic simple en dehors du pavé ou sur une des deux cellules colorées en orange se produit parfaitement.

Le résultat du fonctionnement de la macro me convient donc à 100% maintenant.
Merci Nicolas.
Webperegrino
 
- 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
Retour