XL 2016 cellules en surbrillance en fonction de l'activecell

Lorenzini

XLDnaute Occasionnel
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 ! :)
 

Pièces jointes

  • Hero Wars.xlsm
    30.8 KB · Affichages: 21

Dranreb

XLDnaute Barbatruc
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
 
Dernière édition:

mapomme

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

Pièces jointes

  • Lorenzini- surbrillance titres- v2.xlsm
    34.7 KB · Affichages: 12
Dernière édition:

Lorenzini

XLDnaute Occasionnel
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 ! :D
 

Pièces jointes

  • Hero Wars.xlsm
    29.6 KB · Affichages: 4

Lorenzini

XLDnaute Occasionnel
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 ! :D MERCI mapomme :D
 

Discussions similaires

Réponses
3
Affichages
506