Les coordonnées d'un cercle en VBA

Version imprimable

1 pièce(s) jointe(s)

Pièce jointe 292653

Mon probleme ?
une solution pour pouvoir dessiner le 2 eme cercle par rapport au premier ( les coordonnées du 2 eme par rapport au premier) , autrement dit je veux une relation entre les 2 fonctions et merci d'avance

voici 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
Sub trace_Buse()
    Dim e As Single
    Dim f As Single
    e = 200
    f = 200
    traceBuse e, f
End Sub
 
Function tracecable(pCentreX As Single, pCentreY As Single)
    ActiveSheet.Shapes.AddShape(msoShapeOval, cCentreX, cCentreY, 50, 50).Select
     Selection.ShapeRange.Fill.ForeColor.RGB = coul
End Function
Function trace_cable()
    Dim coul As String
    Dim e As Single
 
    Dim f As Single
    e = 200     'x
    f = 200      'y
    coul = RGB(240, 0, 0)
    tracecable e, f
End Function

Bonjour,

Pour pouvoir positionner tes cercles l'un par rapport à l'autre tu dois déclarer des objets qui représentent tes cercles.
Tu peux ensuite utiliser les propriétés des objets.

Exemple 1 :

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
Option Explicit
 
Sub trace_Buse()
Dim buse As Shape
Dim e As Single
Dim f As Single
    e = 200
    f = 200
    Set buse = traceBuse(e, f)
    MsgBox "L : " & Chr(9) & buse.Left & vbCr & _
           "T : " & Chr(9) & buse.Top & vbCr & _
           "H : " & Chr(9) & buse.Height & vbCr & _
           "W : " & Chr(9) & buse.Width
End Sub
 
Function traceBuse(bCentreX As Single, bCentreY As Single) As Shape
 Set traceBuse = ActiveSheet.Shapes.AddShape(msoShapeOval, bCentreX, bCentreY, 200, 200)
End Function
 
Function trace_cable()
Dim cable As Shape
Dim coul As Long
Dim e As Single
Dim f As Single
    e = 200     'x
    f = 200      'y
    coul = RGB(240, 0, 0)
    Set cable = tracecable(e, f)
    cable.Fill.ForeColor.RGB = coul
    MsgBox "L : " & Chr(9) & cable.Left & vbCr & _
           "T : " & Chr(9) & cable.Top & vbCr & _
           "H : " & Chr(9) & cable.Height & vbCr & _
           "W : " & Chr(9) & cable.Width
End Function
 
Function tracecable(pCentreX As Single, pCentreY As Single) As Shape
  Set tracecable = ActiveSheet.Shapes.AddShape(msoShapeOval, pCentreX, pCentreY, 50, 50)
End Function

Exemple 2, cercles concentriques :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Option Explicit
Sub Dessin()
Dim Buse As Shape, Cable As Shape
Dim X!, Y!, Øb!, Øc!, C&
    X = 200: Y = 200: Øb = 160: Øc = 50
    Set Buse = TraceCercle(X, Y, Øb)
    X = Buse.Left + Øb / 2 - Øc / 2: Y = Buse.Top + Øb / 2 - Øc / 2
    Set Cable = TraceCercle(X, Y, Øc)
    C = RGB(240, 0, 0)
    Cable.Fill.ForeColor.RGB = C
End Sub
 
Function TraceCercle(Gauche!, Haut!, Diamètre!) As Shape
 Set TraceCercle = ActiveSheet.Shapes.AddShape(msoShapeOval, Gauche, Haut, Diamètre, Diamètre)
End Function

Exemple 2, cercles concentriques :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 Option Explicit Sub Dessin() Dim Buse As Shape, Cable As Shape Dim X!, Y!, Øb!, Øc!, C& X = 200: Y = 200: Øb = 160: Øc = 50 Set Buse = TraceCercle(X, Y, Øb) X = Buse.Left + Øb / 2 - Øc / 2: Y = Buse.Top + Øb / 2 - Øc / 2 Set Cable = TraceCercle(X, Y, Øc) C = RGB(240, 0, 0) Cable.Fill.ForeColor.RGB = C End Sub Function TraceCercle(Gauche!, Haut!, Diamètre!) As Shape Set TraceCercle = ActiveSheet.Shapes.AddShape(msoShapeOval, Gauche, Haut, Diamètre, Diamètre) End Function
[/QUOTE]

Mr Patrique je vous remercie pour votre effort , pour le 2 eme exemple y a t il une possibilité de modifier les coordoné du cable par rapport au buse
je m'explique :
je veux que mon buse reste figé ( constant il se deplace pas ) et c'est le cable qui se déplace dans le bus ou a l'exterieur

09/07/2017, 23h43
Patrice740

Re,

« y a t il une possibilité de modifier les coordoné du cable par rapport au buse »
C'est déjà le cas, les coordonnées X et Y du câble sont calculées par rapport à la position de la buse (voir ligne 7)
09/07/2017, 23h53
xomus

Citation:

Envoyé par Patrice740

Re,

« y a t il une possibilité de modifier les coordoné du cable par rapport au buse »
C'est déjà le cas, les coordonnées X et Y du câble sont calculées par rapport à la position de la buse (voir ligne 7)

Mr Patrick , ca me donné un cable concentrique , je veux que le cable se positionne comme il veut dans le Buse ( excuse moi je ne suis pas expert du BVA)
10/07/2017, 00h01
Patrice740

« je veux que le cable se positionne comme il veut »
hein ????
A ma connaissance, un câble n'a pas d'esprit décisionnel, comment peux-t'on savoir ce qu'il veut ?
10/07/2017, 00h06
xomus

Citation:

Envoyé par Patrice740

« je veux que le cable se positionne comme il veut »
hein ????
A ma connaissance, un câble n'a pas d'esprit décisionnel, comment peux-t'on savoir ce qu'il veut ?

ça veut dire que j'ai le Buse qui est constant , et quand je tape les coordonée du cable , soit il se dessine à l'interieur ( pas forcement au centre) ou soit à l'exterieur