Repérage dans un tableau

Version imprimable

29/05/2009, 08h31
Daranc

Repérage dans un tableau
Un petit truc avec une macro évènementielle :

dans le code de la feuille sur sélection change
Code:

1 2 3 4 Private Sub Worksheet_SelectionChange(ByVal Target As Range) Cells(5, 2).Value = ActiveCell.Row Cells(6, 2).Value = ActiveCell.Column End Sub
dans la mise en forme conditionnelle
Code:

1 2 La formule est :=LIGNE()=$B$5 mettre en format la ligne supérieur et inférieur en rouge La formule est :=COLONNE()=$B$6 mettre en format le coté droit et le coté gauche en rouge
recopier le format sur l'ensemble du tableau
la cellule active sera pointée par une croix
d'autre mise en évidence sont possible pour la cellule ciblée on peut mettre un format gras ou/et un fond beige la seule chose a se rappeler : c'est de mettre en premier la condition qui regroupe ligne et colonne
dans une formule du type

Code:

la formule est : =ET(LIGNE()=$B$5;COLONNE()=$B$6
29/05/2009, 13h05
casefayere

Bonjour Daranc,

apparemment, une petite erreur ici

Code:

=ET(LIGNE()=$B$5.COLONNE()=$B$6

que je corrigerais comme ça

Code:

=ET(LIGNE()=$B$5;COLONNE()=$B$6)

à moins que je n'ai rien compris

bonne journée
02/06/2009, 11h17
Daranc

OUPS!
(P.... de touche clapload)
03/06/2009, 12h50
ouskel'n'or
Juste pour le fun, pisk tu as Target et que Target est la cellule active, pourquoi ne pas l'utiliser ?
Code:

1 2 3 4 Private Sub Worksheet_SelectionChange(ByVal Target As Range) Cells(5, 2).Value = Target.Row Cells(6, 2).Value = Target.Column End Sub
;)
Par contre j'ajouterais un test afin de savoir si tu as une ou plusieurs cellules sélectionnées car dans le second cas tu n'auras les coordonnées que de la première cellule de ta plage.
Je complique ? Bon, je ne dis plus rien :|

Salut,
Je me permets d'ajouter mon grain de sel... voici deux possibilités que j'ai utilisées dans certains de mes fichiers.

La première avec un "Interior"

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
 
Cells.Interior.ColorIndex = xlNone
 
    With Range(Cells(Target.Row, 1), Cells(Target.Row, Target.Column)).Interior
        .Pattern = xlGray8
        .PatternColorIndex = 3
    End With
 
    With Range(Cells(1, Target.Column), Cells(Target.Row, Target.Column)).Interior
        .Pattern = xlGray8
        .PatternColorIndex = 3
    End With
 
End Sub

Ou avec des shapes, ce qui correspond plus au Post initial

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If ActiveCell.Count > 1 Then GoTo fin
    '*** Définition des variables ***
    H = ActiveCell.Height
    w2 = ActiveCell.Width
    T = ActiveCell.Top
    W = ActiveCell.Left
 
    'Supprime les rectangles si existent déjà.
    On Error Resume Next
    ActiveSheet.Shapes("RectangleV").Delete
    On Error Resume Next
    ActiveSheet.Shapes("RectangleH").Delete
 
    'Ajoute les rectangles
    ActiveSheet.Shapes.AddShape(msoShapeRectangle, 0, T, W, H).Name = "RectangleV"
    With ActiveSheet.Shapes("RectangleV")
        .Fill.Visible = msoFalse
        .Fill.Transparency = 0#
        .Line.Weight = 3#
        .Line.ForeColor.SchemeColor = 10
        .PrintObject = False
 
    End With
 
    ActiveSheet.Shapes.AddShape(msoShapeRectangle, W, 0, w2, T).Name = "RectangleH"
 
    With ActiveSheet.Shapes("RectangleH")
        .Fill.Visible = msoFalse
        .Fill.Transparency = 0#
        .Line.Weight = 3#
        .Line.ForeColor.SchemeColor = 10
        .PrintObject = False
    End With
fin:
 
End Sub

A+