Tracer un arc de cercle sous excel???

Question

Bonjour,

J'essaye (en vain!!!) de tracer un arc de cercle sous Excel...

J'ai bien trouvé un moyen avec:

With Shapes.AddShape(msoShapeArc, 10, 10,20 ,30 )
End with

mais on obtient un arc de cercle d'angle 90°... 

Moi, je voudrais:
 - soit tracer un arc de cercle passant par trois points dont je connais les coordonnées (départ, milieu, arrivée);
 - soit tracer un arc de cercle dont je connais le centre, le rayon l'angle de départ et celui d'arrivée.  
... J'ai passé pas mal de temps sur le forum pour essayer de trouver une réponse, sans y parvenir.

Quelqu'un pourrait m'aider???

Merci d'avance!

jmfmarques · Answer

Tout dépend...
Es-tu prêt à tracer sur ta Userform plutôt que d'utiliser une Shape ? (encore qu'il de vrait être possible, puisque VBA n'a pas de PictureBox, de tracer sur une autre Userform puis de copier l'image dans un contrôle image "montré")

fredieuric · Answer

Bonjour,

Etant donné que j'ai utilisé des Shapes pour tout le reste de mon projet, je préfèrerai utiliser une Shape pour cet arc de cercle (ce qui m'éviterai de tout refaire...).
De plus, n'étant pas un expert en VBA, je ne sais pas utiliser les Userform, copier les images...
Pourrais-tu me donner plus de détail sur la solution que tu as envisagée?

Merci!

jmfmarques · Answer

Ne marcherait pas avec des shapes !

Je ne connais pas grand chose  en VBA mais peux toujours te proposer ceci (avec utilisation d'une userForm) :
1) Utiliser la fonction Arc de la librairie gdi32 (API) pour dessiner sur une userform (VBA n'a pas à ma connaissance de PictureBox)
2) transférer dans un contrôle image le résultat de ce dessin.

jmfmarques · Answer

Essaye (phase de test avant de continuer ) ce code en changeant Form par UserForm, pour voir ce que celà fait sur ton UserForm et dis-moi.
Il est possible que tu aies à changer (VBA) Activate par Initialize.
Un spécialiste VBA pourrait peut-être me compléter, au besoin (tant pour cette phase que pour celles qui vont suivre)

jmfmarques · Answer

Zut j'ai oublié l'essentiel, que voilà donc :

Private Declare Function Arc Lib "gdi32" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long, ByVal X3 As Long, ByVal Y3 As Long, ByVal X4 As Long, ByVal Y4 As Long) As Long


Private Sub Form_Activate()
    Me.AutoRedraw = True
    Arc Me.hdc, 10, 10, 100, 150, 10, 10, 30, 120
End Sub

fredieuric · Answer

En fait, voici un code (Merci Chewi!)  qui permet de tracer un arc de cercle en modifiant la msoshapearc:

Sub Arc()
Dim x AsSingle
Dim y AsSingle
x = 100
y = 100
ActiveSheet.Shapes.AddShape(msoShapeArc, x, y, 200, 150).Select
Selection.ShapeRange.Adjustments.Item(1) = 270
Selection.ShapeRange.Adjustments.Item(2) = 45
EndSub

Merci encore pour vos réponses, et en espérant que ça puissent servir à d'autres!

patrick461962 · Answer

Bonjour,

Private Sub Form_Activate()
    Me.AutoRedraw = True ' il faut mettre Me.Repaint en VBA
    Arc Me.hdc, 10, 10, 100, 150, 10, 10, 30, 120
End Sub

yassine123456789 · Answer

salut.je ne sai pas quesque c'est ce syte ni comment je me suit inscrit.

yassine123456789 · Answer

salut.je ne sai pas quesque c'est ce syte ni comment je me suit inscrit.

zonedhea · Answer

Ce code permet de tracer des courbes suivant des rayons X et Y différent, il et simplement nécessaire de mettre sur la feuille 2 Scrollbars sur la feuille 1, et de redimensionner la taille des cellules




Private Sub Workbook_Open()
  Worksheets("feuil1").Cells.Clear
  Worksheets("feuil1").Rows(71).Interior.ColorIndex = 1
  Worksheets("feuil1").Rows("72:200").Interior.ColorIndex = 16
  Worksheets("feuil1").Rows("1:70").Interior.ColorIndex = 36
  Worksheets("feuil1").ScrollBar1 = 1
  Worksheets("feuil1").ScrollBar2 = 1
  Worksheets("feuil1").Cells(1, 1).Select
End Sub

Private Sub ScrollBar1_Change()
  trace
End Sub


Private Sub ScrollBar2_Change()
  t race
End Sub

Sub trace()
  On Error GoTo exitsub


  Rows("1:70").Interior.ColorIndex = 36
  xx = Feuil1.ScrollBar1.Value
  yy = Feuil1.ScrollBar2.Value


  R = 70
  C = 65
  PY = Int(C - Cos(0) * yy) - 2


  For i = 0 To 3.5 Step 0.01
    x = Int(R - Sin(i) * xx)
    y = Int(C - Cos(i) * yy) - PY
    If x > R Then Exit For
    Cells(x, y).Interior.ColorIndex = 3
  Next i


  exitsub:
  Resume Next
   
End Sub

ZoneDHEA

Tracer un arc de cercle sous excel???

10 réponses

Votre réponse

Discussions similaires