XL 2016 cellules en surbrillance en fonction de l'activecell

Lorenzini · 24 Avril 2021

Bonjour,

Je cherche à mettre, en surbrillance (une autre couleur de fond, p.ex. vert "nature" ;p ) 2 cellules par rapport à celle que je sélectionne dans mon tableau, qui va de B3 à U22.
P; ex. si je clique en G11, j'aimerais que la cellule G2 (le titre de la colonne, ici : "Bastion de la glace") et B11 (le nom de la ligne, ici : "Laurent") soient p.ex. en vert.
J'ai déjà bcp de mal (avec mes connaissances très limitée de VBA) à imaginer ces qq lignes de programmation mais là où çà devient encore plus compliqué (voire carrément impossible), ce serait que j'aimerais dès que je sélectionne une AUTRE cellule du tableau, et bien, que la 1ère cellule que j'ai quittée pour atterrir dans la nouvelle REPRENNE sa couleur de fond initiale (et que la nouvelle soit à son tour en surbrillance).
J'avoue que je bugge... -o-O-
Quelqu'un pourrait-il m'éclairer SVP ?
Merci d'avance à tous !

Dranreb · 24 Avril 2021

Bonjour.
Je le ferais peut être comme ça :

Code:

[Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   If Not Intersect(Range("B3:U22"), Target) Is Nothing And Target.Count = 1 Then
      On Error Resume Next
      Me.[CelSel].Interior.Color = Me.[ClrSel]
      Me.[CelCoG].Interior.Color = Me.[ClrCoG]
      On Error GoTo 0
      Me.Names.Add "CelSel", Target
      Me.Names.Add "ClrSel", Target.Interior.Color
      Target.Interior.Color = &HFFA5&
      Set Target = Target.EntireColumn.Rows(2)
      Me.Names.Add "CelCoG", Target
      Me.Names.Add "ClrCoG", Target.Interior.Color
      Target.Interior.Color = &HFFA5&
      End If
   End Sub

mapomme · 24 Avril 2021

Bonjour @Lorenzini , @Dranreb ,

Une autre méthode via une MFC sur les en-têtes de ligne et colonne pour retrouver ensuite la couleur d'origine.
Le code est dans le module de la feuille "Laurent".

VB:

Option Explicit

Const plage = "b3:u22"

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim macell As Range, plagecol As Range, plagelig As Range

   Set macell = ActiveCell
   Set plagecol = Range(plage).Rows(1).Offset(-1)
   Set plagelig = Union(Range("b2"), Range(plage).Columns(1))
   Union(plagecol, plagelig).FormatConditions.Delete
  
   If Intersect(macell, Range(plage)) Is Nothing Then Exit Sub
  
   With Union(Cells(2, macell.Column).MergeArea, Cells(macell.Row, 2).MergeArea)
      .FormatConditions.Add Type:=xlExpression, Formula1:="=VRAI"
      .FormatConditions(1).Interior.Color = RGB(255, 150, 255)
      .FormatConditions(1).Interior.Pattern = xlSolid
   End With
End Sub

nota : on a ôté la fusion des cellules B1:B2.

Lorenzini · 24 Avril 2021

Dranreb à dit:

Bonjour.
Je le ferais peut être comme ça :

Code:

[Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   If Not Intersect(Range("B3:U22"), Target) Is Nothing And Target.Count = 1 Then
      On Error Resume Next
      Me.[CelSel].Interior.Color = Me.[ClrSel]
      Me.[CelCoG].Interior.Color = Me.[ClrCoG]
      On Error GoTo 0
      Me.Names.Add "CelSel", Target
      Me.Names.Add "ClrSel", Target.Interior.Color
      Target.Interior.Color = &HFFA5&
      Set Target = Target.EntireColumn.Rows(2)
      Me.Names.Add "CelCoG", Target
      Me.Names.Add "ClrCoG", Target.Interior.Color
      Target.Interior.Color = &HFFA5&
      End If
   End Sub

Ah j'adore ! Merci Dranreb ! Je l'ai mis à ma sauce et c'est super nickel ! Après, si je pouvais avoir les titres en surbrillance, ce serait le top du top, mais c'est déjà super bien comme çà ! et les couleurs qui redeviennent ce qu'elles étaient avant ! ah franchement, merci Dranreb !

Lorenzini · 24 Avril 2021

mapomme à dit:

Bonjour @Lorenzini , @Dranreb ,

Une autre méthode via une MFC sur les en-têtes de ligne et colonne pour retrouver ensuite la couleur d'origine.
Le code est dans le module de la feuille "Laurent".

VB:

Option Explicit

Const plage = "b3:u22"

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim macell As Range, plagecol As Range, plagelig As Range

   Set macell = ActiveCell
   Set plagecol = Range(plage).Rows(1).Offset(-1): plagecol.FormatConditions.Delete
   Set plagelig = Union(Range("b2"), Range(plage).Columns(1)): plagelig.FormatConditions.Delete

   If Intersect(macell, Range(plage)) Is Nothing Then Exit Sub

   With Cells(2, macell.Column).MergeArea
      .FormatConditions.Add Type:=xlExpression, Formula1:="=VRAI"
      .FormatConditions(1).Interior.Color = RGB(255, 150, 255)
      .FormatConditions(1).Interior.Pattern = xlSolid
   End With

   With Cells(macell.Row, 2).MergeArea
      .FormatConditions.Add Type:=xlExpression, Formula1:="=VRAI"
      .FormatConditions(1).Interior.Color = RGB(255, 150, 255)
      .FormatConditions(1).Interior.Pattern = xlSolid
   End With
End Sub

nota : on a ôté la fusion des cellules B1:B2.

WAAAA ! trop fort !! oh c'est super ! MERCI mapomme

Lorenzini · 24 Avril 2021

Lorenzini à dit:
WAAAA ! trop fort !! oh c'est super ! MERCI mapomme

ah vraiment ! merci les gars ! c vraiment cool merci Dranreb, merci mapomme ! trop bien, je suis trop content ! j'ai encore pas mal à apprendre ...

XL 2016 cellules en surbrillance en fonction de l'activecell

Lorenzini

XLDnaute Occasionnel

Pièces jointes

Dranreb

XLDnaute Barbatruc

mapomme

XLDnaute Barbatruc

Pièces jointes

Lorenzini

XLDnaute Occasionnel

Pièces jointes

Lorenzini

XLDnaute Occasionnel

Lorenzini

XLDnaute Occasionnel

Discussions similaires