tracer connecteur entre 2 cellules

[LouisFinn]

Bonjour,

débutant sur Excel je souhaiterais savoir s'il est possible de lui faire tracer automatiquement un connecteur droit (forme automatique) entre deux cellules sélectionnées au préalable.Par exemple: je sélectionne (clic) H8 puis (clic) N12 et elles seraient reliées par un trait (connecteur droit dans forme automatique).Après quoi la dernière sélectionnée (N12) pourra être reliée à une suivante qui serait à son tour sélectionnée, de façon à tracer un "itinéraire" de cellule en cellule sélectionnées au fur et à mesure...Un petit coup de pouce ou une "formule magique" seraient les bienvenus avec toute ma gratitude !Merci d'avance (si c'est faisable...)

 

[job75]

Re : tracer connecteur entre 2 cellules

Bonsoir LouisFinn, bienvenue sur XLD,

Voyez le fichier joint.

Les macro sont dans le code de la feuille (clic droit sur l'onglet et Visualiser le code) et dans le Module1 (Alt+F11).

Bonne nuit.

 

[LouisFinn]

Re : tracer connecteur entre 2 cellules

Formidable ! C'est exactement ce qu'il me fallait ! Merci beaucoup pour votre aide !

 

[Aure22]

Re : tracer connecteur entre 2 cellules

Bonjour,
je ne sais pas si je peux prolonger le post. Je ne connais rien à VBA. Mais j'ai essayé d'exploiter ce que job75 a produit. Est ce que vous pourriez m'aider à aller plus loin?

En clair, je voudrais que lorsqu'on clique sur une cellule de la colonne de gauche puis sur cellule de la colonne de droite, un trait soit tracé entre les deux. Je voudrais pouvoir réitérer les clics sans que tous soient reliés entre eux.
Le top du top serait de pouvoir tracer des traits de couleurs différentes à chaque fois et d'attribuer ses traits à une personne particulière.
J'ai essayé de joindre un image mais ça ne marche pas très bien..


Dites moi si c'est du rêve où si vous pouvez m'aider.
D'avance merci beaucoup!

 

[job75]

Re : tracer connecteur entre 2 cellules

Bonsoir Aure22, bienvenue sur XLD,

Voyez le fichier joint et ce code :

Dim P1 As Range, P2 As Range, c As Range 'mémorise les variables

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Set P1 = [A6:A25]: Set P2 = [E3:E28] 'plages à adapter
Cancel = True
If Not Intersect(Target, P1) Is Nothing Then
  Set c = Target
  P1.Borders.LineStyle = xlNone
  c.Borders.Weight = xlThick
ElseIf Not c Is Nothing And Not Intersect(Target, P2) Is Nothing Then
  Target.Interior.Color = c.Interior.Color
  Me.Shapes.AddLine c.Left + c.Width, c.Top + c.Height / 2, Target.Left, Target.Top + Target.Height / 2
  Me.DrawingObjects.ShapeRange.Line.ForeColor.SchemeColor = 12 'couleur bleue
End If
End Sub

Sub EffaceConnecteurs() 'se lance par Ctrl+E
If P1 Is Nothing Then Exit Sub
Me.DrawingObjects.Delete
P1.Borders.LineStyle = xlNone
P2.Interior.ColorIndex = xlNone
Set c = Nothing
End Sub

Il n'y a aucun intérêt à modifier la couleur des connecteurs.

A+

 

[Aure22]

Re : tracer connecteur entre 2 cellules

Poapopop!
Merci beaucoup. J'adorerai comprendre et pouvoir en faire autant!
Un jour peut être,
merci encore!

 

[R.R.]

Bonjour,

Tout d'abord, merci et bravo pour votre travail Job75 ! Dans bien des cas, il m'a permis de me sortir de situations délicates et m'a fait progresser en VBA. Mais je coince ici, malgré les post précédents. Mon problème est légèrement différent, même s'il reste sur le même type de problématique : je souhaiterai tracer un connecteur entre deux cellules dont les valeurs sont données dans un tableau. Il y aurait 4 connecteurs indépendants à tracer : un pour chaque joueur. Je joins une image pour éclaircir ma demande.

Merci d'avance pour vos réponses !

 

[R.R.]

Le fichier propre de toutes macros en plus, c'est peut-être mieux ...

 

[job75]

Bonsoir R.R.,

Je ne vois pas trop l'intérêt de mettre des connecteurs mais bon.

Il suffit d'utiliser les macros de mon post #2, sans mettre de couleur.

Fichier joint.

Bonne nuit.

 

[job75]

Bonjour R.R., le forum,

Un code allégé et mieux adapté à votre problème :

Dim cel As Range, couleur& 'mémorise les variables

Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Range, colPasse$, colPoints$
Set r = [J4:J10] 'plage à adapter
colPasse = "E" 'à adapter
colPoints = "H" 'à adapter
DrawingObjects.Delete 'RAZ
On Error Resume Next 'si la cellule ne peut être touvée
For Each r In r
  If r <> "" Then
    Set cel = Nothing 'réinitialise
    couleur = r.Interior.Color
    MaSelection r.MergeArea 'car cellule fusionnée
    MaSelection Columns(colPoints).Find(r(1, 3), , xlValues, xlWhole)
    MaSelection Columns(colPasse).Find(r(1, 2))
  End If
Next
End Sub

Sub MaSelection(Target As Range)
If Not cel Is Nothing Then _
  Shapes.AddLine(cel.Left, cel.Top + cel.Height / 2, Target.Left + Target.Width, Target.Top + Target.Height / 2) _
    .Line.ForeColor.RGB = couleur
Set cel = Target
End Sub

Il y a une couleur différente pour chaque joueur.

Fichier (2).

A+

 

[R.R.]

Bonjour le forum et bonjour Job75. Un grand merci pour vos réponses !

Le connecteur qui relie les deux chiffres du nomogramme (passes et points) marche à merveille et la couleur pour chaque joueur correspond parfaitement à ce que je cherche. Peut-on supprimer le connecteur qui relie le 2ème chiffre du nomogramme (points) avec le nom du joueur dans le tableau ? J'essaie de trouver le bout de code qui fait cela mais je ne trouve pas pour le moment.

A très vite et encore merci. Cela me fait avancer d'un grand pas dans ce fichier. Charge à moi de comprendre le codage (merci de vos commentaires dans le code).

R.R.

 

[job75]

Re,

J'essaie de trouver le bout de code qui fait cela mais je ne trouve pas pour le moment.

Pas bien sorcier, il suffit de supprimer la ligne :

MaSelection r.MergeArea 'car cellule fusionnée

Fichier (2 bis).

A+

 

[R.R.]

Ah oui ... Ben voilà qui est fait ! Mon fichier fonctionne parfaitement. Merci encore Job75 !

A ++