[Résolu] "Cross Hair" ou repère en croix d'une cellule

[apnart]

Bonjour,

Ayant un "gros tableau" à faire remplir par pas mal de monde (chacun sa ligne), je souhaiterais leur éviter de se tromper de ligne ou de colonne...

Je cherche donc un dispositif qui suivrait la souris et ferait une sorte de croix ligne/colonne avec la cellule en question au centre, donc déjà visible sans cliquer (il me semble que open office fait ça de base)

Restrictions : Mon tableau comporte des cases avec des couleurs et des validations conditionnelles.

Ce que je trouve au mieux sur le web parle de "cross hair", mais j'ai rien réussi à faire fonctionner

Si vous avez ça dans un coin, ça m'aiderait beaucoup.

Merci d'avance,
Bruno.

 

[apnart]

Re : "Cross Hair" ou repère en croix d'une cellule

Aie... je le craignais, vu ce que je n'ai pas trouvé sur le web, ça à l'air plutôt compliqué... ou infaisable

 

[Modeste geedee]

Re : "Cross Hair" ou repère en croix d'une cellule

Bonsour®

encore faut-il chercher au bon endroit ...
La mise en forme conditionnelle

autre méthode :
http://www.polykromy.com/nl/nl6/nl6.html
http://www.polykromy.com/fichiers/rectangle.xls

 

[Misange]

Re : "Cross Hair" ou repère en croix d'une cellule

Bonjour
Comme indiqué par GeeDee il y a plein d'exemples sur le net.
Par exemple ici aussi :
Ce lien n'existe plus

MAIS si tu as déjà dans tes cellules des MEFC ça complique clairement les choses et ça risque de devenir une usine à gaz.

Si tu as des tas de lignes mais que seules 1 ligne doit être remplie par une personne donnée, le plus simple c'est de masquer les lignes que la personne ne doit pas remplir. Ou bien encore de prévoir une zone de saisie et que le contenu de cette saisie soit recopiée dans la base de données communes.

 

[Modeste geedee]

Re : "Cross Hair" ou repère en croix d'une cellule

Bonsour®

bien que plus complexe la méthode utilisée par Gaëtan, n'utilise pas de MEFC mais des objets éphémères et une proc événementielle...

 

[phlaurent55]

Re : "Cross Hair" ou repère en croix d'une cellule

Bonjour à tous,

voir fichier joint .......... pour le fun

à+
Philippe

 

[Misange]

Re : "Cross Hair" ou repère en croix d'une cellule

Bonjour à tous,

voir fichier joint .......... pour le fun

à+
Philippe

Pratique !

 

[BOISGONTIER]

Re : "Cross Hair" ou repère en croix d'une cellule

Bonjour,

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

Positionne un triangle rouge sur la cellule active

http://boisgontierjacques.free.fr/fichiers/Images/CurseurTriangle.xls

Encadre la cellule active ou la sélection en rouge

http://boisgontierjacques.free.fr/fichiers/Images/CurseurRouge.xls

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  On Error Resume Next
  ActiveSheet.Shapes("Curseur").Visible = True
  If Err <> 0 Then
    ActiveSheet.Shapes.AddShape(msoShapeRectangle, 6, 6, 8, 6).Name = "curseur"
    ActiveSheet.Shapes("Curseur").Fill.Visible = msoFalse
    ActiveSheet.Shapes("Curseur").Fill.Transparency = 1
    ActiveSheet.Shapes("curseur").Line.Visible = True
    ActiveSheet.Shapes("curseur").Line.ForeColor.SchemeColor = 10
    ActiveSheet.Shapes("curseur").Line.Weight = 3
  End If
  ActiveSheet.Shapes("curseur").Left = Target.Left
  ActiveSheet.Shapes("curseur").Top = Target.Top
  ActiveSheet.Shapes("curseur").Height = Selection.Height
  ActiveSheet.Shapes("curseur").Width = Selection.Width
End Sub

JB

 

[apnart]

Re : "Cross Hair" ou repère en croix d'une cellule

Merci phlaurent55 pour l'essai, un peu "lourd" à mettre en oeuvre pour moi car il faut copier autant de traits que de lignes (et j'en ai pas mal) et quand le tableau bouge (ajout/suppression de ligne) ça fait des manips en plus. Mais MERCI

Merci BOISGONTIER pour ce SUPER FICHIER Il est vraiment plein d'idées que je me garde sous le coude (certains onglets ne semble pas marcher chez moi au 1er abord, je vais regarder au 2ème "rabord" )

Je suis très intéressé par plusieurs solutions :

- CurseurLigneCol :
ça fait exactement ce que je cherche comme effet, mais si je colorie la case intersection, quand je me déplace sur une autre case, la couleur que l'ai mis disparait.

-LigneActiveSurlignée2 :
Juste la ligne, mais avec de la transparence, ce qui est très bien, mais si je colorie une case, c'est toute la ligne qui est mise en couleur :-(

- LigneColonneActiveSurlignée : serait mieux qu'au dessus, mais marche pas chez moi :-(

- LigneHoriz :
Me parait être un bon compromis.
-- est-il possible d'avoir également une ligne au dessus de la cellule (actuellement en dessous) ?
-- est-il possible aussi d'avoir la même chose en vertical ?

Un p'tit coup de main supplémentaire pour le dernier point ?

Merci encore, j'entrevois une porte de sortie pour mon soucis

 

[BOISGONTIER]

Re : "Cross Hair" ou repère en croix d'une cellule

voir pj

JB

 

[apnart]

Re : "Cross Hair" ou repère en croix d'une cellule

PERFECTO m'sieur BOISGONTIER !

Du coup j'ai fait 3 traits, 1 dessus, 1 dessous, et 1 à gauche... c'est pile poil parfait !

MERCI BEAUCOUP !

 

[Modeste geedee]

Re : "Cross Hair" ou repère en croix d'une cellule

Bonsour®

http://www.polykromy.com/fichiers/rectangle.xls ©2001

Dans la macro, se trouve les commandes suivantes :

.Line.ForeColor.SchemeColor = 10
C'est cette propriété qui gère la couleur du repère.
Il suffit alors de changer ce nombre pour modifier la couleur du repère.

Vous pouvez aussi vous amuser à changer la taille du trait :
.Line.Weight = 3#

également la transparence
.Fill.Transparency = 1#

de plus les repères n'apparaissent ni à l'aperçu ni à l'impression

 

[Si...]

Re : [Résolu] "Cross Hair" ou repère en croix d'une cellule

salut

puisque c'était fait ...

 

[apnart]

Re : [Résolu] "Cross Hair" ou repère en croix d'une cellule

Merci également à Modeste, j'avais vu les liens et oublié de remercier... pardon

Pour la Solution de Si... merci également, mais la solution de BOIS est celle qui va mieux me correspondre

 

[apnart]

Re : [Résolu] "Cross Hair" ou repère en croix d'une cellule

Bonjour,

Je reviens sur le sujet car j'ai un soucis que je n'avais pas vu lors de mes test

Tout fonctionne très bien jusqu'à ce que je "hide" 1 ligne, ce qui me fait disparaître 1 trait horizontal, et si j'en masque 2 et plus, je n'ai plus de trait horizontal du tout

Voici le code que j'utilise :

Private Sub Worksheet_SelectionChange(ByVal Target As Range)  Set champ = [A3:NC90]
  If Not Intersect(champ, Target) Is Nothing Then
    On Error Resume Next
    Shapes("curseurH1").Visible = True
    If Err <> 0 Then ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, 1, 1, 1000, 1).Name = "curseurH1"
    
    Shapes("curseurH2").Visible = True
    If Err <> 0 Then ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, 1, 1, 1000, 1).Name = "curseurH2"
    
    Shapes("curseurV1").Visible = True
    If Err <> 0 Then ActiveSheet.Shapes.AddTextbox(msoTextOrientationVertical, 1, 1, 1000, 1).Name = "curseurV1"
    
    Shapes("curseurV2").Visible = True
    If Err <> 0 Then ActiveSheet.Shapes.AddTextbox(msoTextOrientationVertical, 1, 1, 1000, 1).Name = "curseurV2"
    
    ActiveSheet.Shapes("curseurH1").Line.ForeColor.RGB = RGB(255, 0, 0)     ' trait du dessous
    Shapes("curseurH1").Top = ActiveCell.Top + ActiveCell.Height
    Shapes("curseurH1").Left = champ.Left
    Shapes("curseurH1").Height = 0.2
    Shapes("curseurH1").Width = champ.Width
    
    ActiveSheet.Shapes("curseurH2").Line.ForeColor.RGB = RGB(255, 0, 0)     ' trait du dessus
    Shapes("curseurH2").Top = ActiveCell.Top '+ ActiveCell.Height
    Shapes("curseurH2").Left = champ.Left
    Shapes("curseurH2").Height = 0.2
    Shapes("curseurH2").Width = champ.Width
    
    ActiveSheet.Shapes("curseurV1").Line.ForeColor.RGB = RGB(255, 0, 0)     ' trait de gauche
    Shapes("curseurV1").Top = champ.Top ' + ActiveCell.Height
    Shapes("curseurV1").Left = ActiveCell.Left ' + ActiveCell.Height
    Shapes("curseurV1").Height = champ.Height
    Shapes("curseurV1").Width = 0.2
    
    ActiveSheet.Shapes("curseurV2").Line.ForeColor.RGB = RGB(255, 0, 0)     ' Trait de droite
    Shapes("curseurV2").Top = champ.Top '+ ActiveCell.Height
    Shapes("curseurV2").Left = ActiveCell.Left + ActiveCell.Width
    Shapes("curseurV2").Height = champ.Height
    Shapes("curseurV2").Width = 0.2
    
  Else
    On Error Resume Next
    Shapes("curseurH1").Visible = False
    Shapes("curseurH2").Visible = False
    Shapes("curseurV1").Visible = False
    Shapes("curseurV2").Visible = False
  End If
  End Sub

des idées ?