Problème de coordonnées - VBA Excel

Version imprimable

19/03/2017, 22h10
Kachu

Problème de coordonnées - VBA Excel
Bonjour,
J'ai un problème un peu particulier avec VBA sur Excel. Mon objectif est d'écrire une fonction qui, ayant pour argument la position (X et Y) de plusieurs points, leurs amplitudes (vitesse) et leurs directions (en degrés), la fonction retourne le nombre des positions (Range.rows.count) et trace des flèches (représentant ainsi un champ de vitesse).
Jusque là tout va bien, j'ai réussi à écrire la fonction en traçant les flèches. Le problème est la direction. J'ai donc écrit un code plus simple pour mieux manipuler la direction d'une flèche :
Code:

1 2 3 4 5 6 Sub ligne() With Worksheets("Feuil1") Set arrow = .Shapes.AddConnector(msoConnectorStraight, 300, 300, 400, 400) arrow.Line.EndArrowheadStyle = msoArrowheadOpen End With End Sub
Le problème est au niveau de la ligne 3 (sachant que (300,300) est le point de départ et (400,400) et le point d'arrivé de la flèche). La première remarque c'est que le point d'origine d'Excel est le coin haut à gauche. La deuxième est que les Ys positives vont vers le bas. Tant que les valeurs des Xs Ys sont positives, j'arrive à représenter la flèche où je veux. Par contre, dès que j'introduis une valeur négative (peu importe où), l'origine du repère change de position. Je ne sais donc pas s'il y a moyen de fixer cet origine dans un autre endroit de manière à ce qu'on peut visualiser et la partie négative et la partie positive ? ou bien comment varie l'origine en fonction des valeurs négatives ?

Merci pour votre aide.

Bonjour,

Ah la trigonométrie !
En utilisant des lignes transformées en flèches. La proc trace un cercle de flèches depuis un point central tout les 10 degrés.
A toi d'en déduire pour calculer tes points. Reviens si tu as des difficultés :

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
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
 
Sub Fleche()
 
    Dim Fe As Worksheet
    Dim Trait As Shape
    Dim R_Cercle As Single
    Dim D_Cercle As Single
    Dim G_Cercle As Single
    Dim H_Cercle As Single
    Dim Arc As Single
    Dim Angle As Single
    Dim I As Integer
    Dim Max As Integer
 
    Const Pi As Single = 3.14159265358979
 
    Set Fe = ActiveSheet
 
    'supprime les shapes existants
    For Each Trait In Fe.Shapes: Trait.Delete: Next Trait
 
    G_Cercle = 100 'position du bord du cercle par rapport au coté gauche de la feuille
    H_Cercle = 100 'position du bord du cercle par rapport au coté haut de la feuille
    D_Cercle = 500 'diamètre
    R_Cercle = D_Cercle / 2 'rayon
 
    'tout les 10 degrés
    Max = 36
 
    'longueur de l'arc
    Arc = D_Cercle * Pi / Max
 
    'angle découlant de la longueur de l'arc
    Angle = Arc / R_Cercle
 
    For I = 1 To 36
 
        'traits en pointillés depuis le centre
        Set Trait = Fe.Shapes.AddLine(G_Cercle + R_Cercle, _
                                      H_Cercle + R_Cercle, _
                                      G_Cercle + R_Cercle + R_Cercle * Sin(Angle * I), _
                                      H_Cercle + (R_Cercle - R_Cercle * Cos(Angle * I)))
 
        'transforme en flèche
        Trait.Line.EndArrowheadStyle = 2
 
    Next I
 
End Sub

Bonjour,
Je vous remercie pour la réponse. Je la garde je pourrai en avoir besoin. En tout cas j'ai pu résoudre mon problème en me cassant un peu la tête. Le truc c'est que j'ai manipulé les écarts pour "tromper" Excel lol. Je peux vous détailler si ça vous intéresse. En tout cas, voici une procédure test :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 Sub test() With Worksheets("Feuil2") Dim arrow(3) As Shape Set arrow(1) = .Shapes.AddConnector(msoConnectorStraight, 300, 200, 100, 100) Set arrow(2) = .Shapes.AddConnector(msoConnectorStraight, 400, 200 - (250 - 200), 200, (200 - 250) + 150) Set arrow(3) = .Shapes.AddConnector(msoConnectorStraight, 500, 200 - (360 - 200), 300, (300 - 360) + 40) arrow(1).Line.EndArrowheadStyle = msoArrowheadOpen arrow(2).Line.EndArrowheadStyle = msoArrowheadOpen arrow(3).Line.EndArrowheadStyle = msoArrowheadOpen End With End Sub