Discussion :

[awa123]

Bonjour,

Je cherche à créer une flèche reliant mon point de départ et mon point d'arrivée dans la partie graphique (feuille "plan" de mon classeur) et qui sont précisé dans ma feuille "données".

j'ai commencé avec le code suivant :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
Sub routes()
 
    Dim sh As Shape
    Dim route As String
    Dim nb As Double
    Dim i As Integer
    Dim cel As Range
 
    Application.ScreenUpdating = False
    Sheets("données").Select
    nb = Sheets("données").UsedRange.Rows.Count
    For Each cel In Range("C2:C" & nb)
        If Not IsEmpty(cel) Then
            route = cel.Value
            Sheets("plan").Select
 
       ' Alors créer une flèche reliant les deux points
 
        End If
    Next cel
 
End Sub

voir mon fichier joint ce sera très clair

merci beaucoup !
Routes apparition fleche.rarRoutes apparition fleche.rar

[mercatog]

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
38
39
Option Explicit
 
Sub Trace()
Dim D As String, A As String
 
'ici on peut boucler pour prendre en considération toutes les données
With Worksheets("Données")
    D = .Range("A2")
    A = .Range("B2")
End With
TraceRoute D, A
End Sub
 
Private Sub TraceRoute(ByVal Depart As String, ByVal Arrivee As String)
Dim ShpD As Shape, ShpA As Shape
 
With Worksheets("Plan")
    On Error Resume Next
    Set ShpD = .Shapes(Depart)
    Set ShpA = .Shapes(Arrivee)
    On Error GoTo 0
 
    If Not ShpD Is Nothing And Not ShpA Is Nothing Then
        With .Shapes.AddConnector(msoConnectorStraight, ShpD.Left, ShpD.Top, ShpA.Left, ShpA.Top)  'msoConnectorCurve'msoConnectorElbow
            With .Line
                .EndArrowheadStyle = msoArrowheadOpen
                .Weight = 2.25
                .ForeColor.RGB = RGB(192, 0, 0)
            End With
            With .ConnectorFormat
                .BeginConnect ShpD, 2
                .EndConnect ShpA, 6
            End With
        End With
    End If
    Set ShpD = Nothing
    Set ShpA = Nothing
End With
End Sub