Coordonnées connecteur elbow

bonjour

Je cherche a récupérer les coordonnées d'un connecteur elbow (celui en U) pour mettre une barre de séparation au milieu de la ligne qui réunit un couple, en cas de séparation

la méthode fonctionne bien avec un connecteur type ligne = Line

curieusement j'ai découvert que le typename d'un connecteur elbow est "Rectangle"

la propriété Top appliquée au connecteur coudé ou elbow donne systématique une valeur fausse trop haute sur l'écran et pas reproductible! alors que les propriétés left et width fonctionnent bien.

je ne comprends pas pourquoi ...

avec une image on se rend mieux compte du problème

y a t il un moyen de récupérer la vraie valeur de top pour le connecteur elbow ?

je dois sélectionner la ligne pour rajouter la barre de séparation et je ne voudrais pas passer par la sélection du carre ou du cercle

Sub coupleSepare()

'
' dessin barre de separation diagonal
'

If TypeName(Selection) = "Line" Or TypeName(Selection) = "Rectangle" Then 'Rectangle correspond à ligne de connection coudée en U !

Dim longueur As Integer
Dim lft As Integer
Dim tp As Integer


With Selection

longueur = Selection.ShapeRange.Width
lft = Selection.ShapeRange.Left
tp = Selection.ShapeRange.Top
'MsgBox lft & ", " & tp

End With

ActiveSheet.Shapes.AddConnector(msoConnectorStraight, lft + (longueur / 2) - 5, tp + 5, lft + (longueur / 2) + 5, tp - 5).Select

With Selection.ShapeRange.Line
.Visible = msoTrue
.ForeColor.ObjectThemeColor = msoThemeColorText1
.ForeColor.TintAndShade = 0
.ForeColor.Brightness = 0
.Transparency = 0
.Weight = 2
End With

End If

End Sub

bonsoir,

Sub coupleSepare()

     If TypeName(Selection) = "Line" Or TypeName(Selection) = "Rectangle" Then     'Rectangle correspond à ligne de connection coudée en U !

          With Selection.ShapeRange
               longueur = Selection.ShapeRange.Width
               lft = .Left + .Width / 2 - 10
               tp = .Top + .Height / 2 + 10
          End With

          With ActiveSheet.Shapes.AddConnector(msoConnectorStraight, lft, tp, lft + 20, tp - 20).Line
               .Visible = msoTrue
               .Weight = 4.25
               .ForeColor.ObjectThemeColor = msoThemeColorText1
          End With

     End If

End Sub

bonjour

merci ça fonctionne, j'ai adapté un peu le code pour avoir le rendu souhaité

Sub connecteur_coupleSepare()

' dessin barre de separation ou divorce

    Dim lft, tp As Integer

    If TypeName(Selection) = "Line" Then
          With Selection.ShapeRange
               lft = .Left + .Width / 2 - 5
               tp = .Top + .Height / 2 + 5
          End With
    End If

    If TypeName(Selection) = "Rectangle" Then 'Rectangle correspond à ligne de connection coudée en U !
          With Selection.ShapeRange
               lft = .Left + .Width / 2 - 5
               tp = .Top + .Height / 2 + 10
          End With
    End If

    With ActiveSheet.Shapes.AddConnector(msoConnectorStraight, lft, tp, lft + 10, tp - 10).Line
            .Visible = msoTrue
            .Weight = 2
            .ForeColor.ObjectThemeColor = msoThemeColorText1
    End With

End Sub