dessin avec Excel

il est possible d'utiliser Excel pour effectuer un dessin en mode trait
le code:

Code:

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
 
Sub dessin_traits()
' test d'evaluation de dessin a partir des donnees d'un tableau
' aux coordonnees X Y
' le but est de dessiner un releve effectue par GPS
        Sheets("COORDONNEES").Select
a = 1
fin_boucle = ActiveSheet.UsedRange.Rows.Count
For C = 3 To fin_boucle
If C = fin_boucle Then
X = X1
Y = Y1
Else
X = (Cells(C, 1).Value) * a
Y = (Cells(C, 2).Value) * a
X1 = (Cells(C + 1, 1).Value) * a
Y1 = (Cells(C + 1, 2).Value) * a
End If
    Sheets("CIRCUIT2").Select
    ActiveSheet.Shapes.AddLine(X, Y, X1, Y1).Select
    Selection.ShapeRange.Line.Weight = 8#
    Selection.ShapeRange.Line.Visible = msoTrue
    Selection.ShapeRange.Line.ForeColor.SchemeColor = 22
        Sheets("COORDONNEES").Select
Next
End Sub

il est aussi possible de dessiner en mode trait continu (une seule ligne)
le code:

Code:

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
 
Sub dessin_ligne()
        Sheets("COORDONNEES").Select
a = 1
fin_boucle = ActiveSheet.UsedRange.Rows.Count
XX = (Cells(3, 1).Value) * a
YY = (Cells(3, 2).Value) * a
    Sheets("CIRCUIT2").Select
With ActiveSheet.Shapes.BuildFreeform(msoEditingAuto, XX, YY)
For C = 4 To fin_boucle
If C = fin_boucle Then
X1 = X + 1
Y1 = Y + 1
Else
        Sheets("COORDONNEES").Select
X = (Cells(C, 1).Value) * a
Y = (Cells(C, 2).Value) * a
X1 = (Cells(C + 1, 1).Value) * a
Y1 = (Cells(C + 1, 2).Value) * a
End If
    Sheets("CIRCUIT2").Select
        .AddNodes msoSegmentLine, msoEditingAuto, X, Y
        .AddNodes msoSegmentLine, msoEditingAuto, X1, Y1
Next
        .ConvertToShape.Select
End With
Set myDocumenT = Worksheets("CIRCUIT2")
myDocumenT.Shapes.SelectAll
    Selection.ShapeRange.Line.Weight = 8#
    Selection.ShapeRange.Line.Visible = msoTrue
    Selection.ShapeRange.Line.ForeColor.SchemeColor = 22
End Sub

le code pour effacer le dessin:

Code:

1
2
3
4
5
6
7
8
9
10
 
Sub supprime()
' effacer le dessin
Set myDocumenT = Worksheets("CIRCUIT2")
myDocumenT.Shapes.SelectAll
Selection.Delete
    Sheets("Feuil1").Select
        Sheets("CIRCUIT2").Select
Selection.Delete
End Sub

Bonsoir,
merci pour votre contribution... pourriez-vous S.V.P la rendre plus compréhensible en décrivant l'environnement nécessaire au fonctionnement du souces ( une feuille CIRCUIT2,....) ainsi qu'un exemple de données ..

pour cela vous pouvez editer votre message en utilisant le bouton http://www.developpez.net/forums/ima...ttons/edit.gif

bonne soirée..

Le source dessin et un essai d'un projet qui servira, a representer un trajet, les coordonnees sont donnees par un GPS.
les coordonnees sont donc extraites d'un fichier (le mieux au format CSV) d'information stockees dans un GPS ces informations contiennent, la latitude, la longitude ce qui nous sert ici mais aussi d'autres informations l'altitude le temps entre chaque point la distance entre chaque point chaque point et une coordonnees latitude, longitude

le source d'exemple