Encadrer les coordonnées

[mamagubida10]

Bonjour,



Il fut une époque où j'étais tomber sur un fichier qui encadrait les coordonnées de ma cellule. Je ne le retrouve pas alors je sollicite votre aide.

Je m'explique :
Ma sélection est la cellule C3
Alors étaient encadrées en rouge la sélection : C1C3 et A1C3

Et quand je me déplace, l'encadrement se déplace.

Avez-vous cette astuce dans votre bibliothèque ?

Je vous remercie.

Cordiales salutations

 

[jpb388]

Re : Encadrer les coordonnées

Bonjour mamagubida10
essayes ceci :

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
With Application
    .EnableEvents = False
    .ScreenUpdating = False
End With
Cells.Interior.Color = xlNone
On Error Resume Next
Range(Cells(1, Target.Column), Cells(Target.Row - 1, Target.Column)).Interior.Color = vbRed
Range(Cells(Target.Row, 1), Cells(Target.Row, Target.Column - 1)).Interior.Color = vbRed
With Application
    .EnableEvents = True
    .ScreenUpdating = True
End With
End Sub

 

[mamagubida10]

Re : Encadrer les coordonnées

Bonjour,


Tout d'abord merci.

C'est presque bon. Le seul souci, est que la macro m'efface toute mes mises en forme de mon fichier. J'avais un tableau avec des couleurs et elles ont été effacées.

 

[Modeste geedee]

Re : Encadrer les coordonnées

Bonsour
Voir celien
La mise en forme conditionnelle

 

[jpb388]

Re : Encadrer les coordonnées

re, Bonjour Modeste geedee

cette fois avec des bordures
testes et dis nous

Dim Cel As Range

Private Sub Worksheet_Activate()
Set Cel = ActiveCell
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
 With Application
     .EnableEvents = False
     .ScreenUpdating = False
 End With
 On Error Resume Next
 Range(Cells(1, Cel.Column), Cells(Cel.Row - 1, Cel.Column)).Borders.Value = 0
 Range(Cells(Cel.Row, 1), Cells(Cel.Row, Cel.Column - 1)).Borders.Value = 0
 Range(Cells(1, Target.Column), Cells(Target.Row - 1, Target.Column)).BorderAround ColorIndex:=3, Weight:=xlThick
 Range(Cells(Target.Row, 1), Cells(Target.Row, Target.Column - 1)).BorderAround ColorIndex:=3, Weight:=xlThick
 With Application
     .EnableEvents = True
     .ScreenUpdating = True
 End With
Set Cel = ActiveCell
 End Sub

 

[BOISGONTIER]

Re : Encadrer les coordonnées

Bonjour,

Exemples divers:

http://boisgontierjacques.free.fr/fichiers/jb-Curseur.xls

JB

 

[mamagubida10]

Re : Encadrer les coordonnées

re, Bonjour Modeste geedee

cette fois avec des bordures
testes et dis nous

Dim Cel As Range

Private Sub Worksheet_Activate()
Set Cel = ActiveCell
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
 With Application
     .EnableEvents = False
     .ScreenUpdating = False
 End With
 On Error Resume Next
 Range(Cells(1, Cel.Column), Cells(Cel.Row - 1, Cel.Column)).Borders.Value = 0
 Range(Cells(Cel.Row, 1), Cells(Cel.Row, Cel.Column - 1)).Borders.Value = 0
 Range(Cells(1, Target.Column), Cells(Target.Row - 1, Target.Column)).BorderAround ColorIndex:=3, Weight:=xlThick
 Range(Cells(Target.Row, 1), Cells(Target.Row, Target.Column - 1)).BorderAround ColorIndex:=3, Weight:=xlThick
 With Application
     .EnableEvents = True
     .ScreenUpdating = True
 End With
Set Cel = ActiveCell
 End Sub

Merci.

Les couleurs restent mais le quadrillage de mes tableaux sautent.

 

[mamagubida10]

Re : Encadrer les coordonnées

Bonjour,

Exemples divers:

http://boisgontierjacques.free.fr/fichiers/jb-Curseur.xls

JB

Merci, l'option "LigneHorizVert" fera l'affaire