Discussion :

[xomus]

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 :

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 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

[Patrice740]

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 :

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
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 :

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

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

[xomus]

Exemple 2, cercles concentriques :

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
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

[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)

[xomus]

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)

[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 ?