PositionCurseur

Retour vers Excel

Retrouver facilement le curseur

Exposé : Pour retrouver facilement la position du curseur dans un grand tableau ou on peut aussi appeller cette page une approche gratuite de l'application disponible chez Polychromy
Voici ce que l'on souhaite obtenir

Je parviens donc à "tracer" une croix jaune qui passe par la cellule sélectionnée, il faut bien sûr que cette couleur disparaisse lorsque je quitte cette cellule... Si des cellules sont déjà colorées pour faire joli, évidemment, ça va poser problème car ces couleurs disparaîtront aussi... c'est l'inconvénient à ce stade

Le code (inspiré d'un lien microsoft)

Option Explicit 

Public x, y As Integer 

Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range) 
'Ceci colore en jaune la ligne et la colonne de la cellule active 
ActiveCell.EntireRow.Interior.ColorIndex = 6 ActiveCell.EntireColumn.Interior.ColorIndex = 6 
'Ce if est exécuté lors de la première exécution, 
'il faut remplir les variables x et y avec l'adresse de la cellule, 'mais ce sera en numérique et ça doit donc être utilisé ensuite avec l'instruction Cells 
If x = Empty Then 
  x = ActiveCell.Row 
  y = ActiveCell.Column
   'une fois que x et y valent qq chose on doit remettre 
  'la couleur à rien, donc remettre l'ancienne ligne et 
  'l'ancienne colonne à blanc 
   ElseIf Not x = ActiveCell.Row Then 
     Rows(x).EntireRow.Interior.ColorIndex = xlColorIndexNone 
    Columns(y).EntireColumn.Interior.ColorIndex = xlColorIndexNone 
    'Comment expliquer ceci ? on a commencé par colorer la nouvelle sélection, 
    'on se retrouvait avec 2 croix jaunes, en remettant les anciennes lignes et colonnes, 
    'là où elles coupent la nouvelle croix jaune, 
    'cela se remet à blanc.... 
    Cells(ActiveCell.Row, y).Interior.ColorIndex = 6 
    Cells(x, ActiveCell.Column).Interior.ColorIndex = 6 
  End If 
  'on capture les valeurs de l'adresse de la cellule active pour 
  'pouvoir les réutiliser au prochain changement de cellules 
  x = ActiveCell.Row 
  y = ActiveCell.Column 
End Sub

On peut aussi obtenir ceci

Le code

Dim x, y As Long 
Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range) 
  On Error Resume Next
  If x = Empty Then 
    x = ActiveCell.Row
    y = ActiveCell.Column 
    With Range(Cells(x, 1), Cells(x, y - 1)) 
      .Interior.ColorIndex = 3 
    End With 
    Range(Cells(1, y), Cells(x - 1, y)).Interior.ColorIndex = 3 
    Cells(x, y).Interior.ColorIndex = 7 
  ElseIf Not x = ActiveCell.Row Then 
    Rows(x).EntireRow.Interior.ColorIndex = xlColorIndexNone 
    Columns(y).EntireColumn.Interior.ColorIndex = xlColorIndexNone 
  End If
   x = ActiveCell.Row 
   y = ActiveCell.Column 
   With Range(Cells(x, 1), Cells(x, y - 1))
      .Interior.ColorIndex = 3 
   End With 
   Range(Cells(1, y), Cells(x - 1, y)).Interior.ColorIndex = 3 
   Cells(x, y).Interior.ColorIndex = 7 
End Sub

Bien sûr ce code n'est pas encore parfait, notamment si on utilise la touche TAB pour se déplacer de cellule en cellule, mais c'est une première approche et il devrait être facilement améliorable. On peut très bien imaginer tracer uniquement les contours des cellules (un cadre - ça ne vous rappelle rien 😉 mais il faut reconnaître que l'on est encore loin du compte)

Un autre code utile lorsque l'on exécute ces essais est de remettre la feuille à blanc

Sub RemiseArien() 
  Cells.Interior.ColorIndex = xlColorIndexNone
End Sub

Cliquez ici pour télécharger le fichier exemple Fichiers

FIN