Arc de cercle dans une feuille excel [Résolu]

Messages postés
14
Date d'inscription
vendredi 11 mai 2007
Dernière intervention
22 août 2007
- - Dernière réponse : akasha21
Messages postés
14
Date d'inscription
vendredi 11 mai 2007
Dernière intervention
22 août 2007
- 5 juin 2007 à 14:57
bonjour,

Je cherche à tracer un arc de cercle sur une feuille excel. je connais le centre et les points des départ et d'arrivée de l'arc.
j'ai essayé l'API arc mais le problème c'est que je n'ai pas de handle sur ma feuille
j'ai aussi essayé la shape Arc mais elle me trace un quart de cercle et je ne sais pas comment la modifier pour obtenir l'arc que je veux.
J'ai cherché sur le site, mais je n'ai pas trouvé. si je rejoins un autre message, dites moi lequel !!

Merci d'avance!!
Afficher la suite 

Votre réponse

20/38 réponses

Meilleure réponse
Messages postés
18
Date d'inscription
samedi 2 juin 2007
Dernière intervention
22 août 2008
3
Merci
Bonsoir,

S'il sagit de dessiner sur une feuille excel,

tu peu utiliser les " objets de forme libre" d'Excel..

Sub TraceArcDeCercle()
       'Utilise Trois points , haut-gauche d5 / haut-Gauche E3 / Haut-Gauche F5
    With ActiveSheet.Shapes.BuildFreeform(msoEditingAuto, [d5].Left, [d5].Top)
        .AddNodes msoSegmentCurve, msoEditingAuto, [E3].Left, [C3].Top
        .AddNodes msoSegmentCurve, msoEditingAuto, [F5].Left, [F5].Top
        .ConvertToShape.Select
    End With
End Sub

Satanas09 ..... Sapristi, saprista, souris grise et face de rat

Dire « Merci » 3

Quelques mots de remerciements seront grandement appréciés. Ajouter un commentaire

Codes Sources 99 internautes nous ont dit merci ce mois-ci

Commenter la réponse de Satanas09
Messages postés
14
Date d'inscription
vendredi 11 mai 2007
Dernière intervention
22 août 2007
3
Merci
voici mon code, il aidera peut-être d'autres personnes(désolée pour la mise en page, je ne sais pas comment faire autrement)

Private Sub arcdecercle(x1 As Single, y1 As Single, x2 As Single, y2 As Single, x3 As Single, y3 As Single, Optional x4 As Single, Optional y4 As Single, Optional x5 As Single, Optional y5 As Single)

Set ws = ActiveSheet

With ws.Shapes.BuildFreeform(msoEditingAuto, x1, y1)
    .AddNodes msoSegmentCurve, msoEditingAuto, x2, y2
    .AddNodes msoSegmentCurve, msoEditingAuto, x3, y3
    .AddNodes msoSegmentCurve, msoEditingAuto, x4, y4
    .AddNodes msoSegmentCurve, msoEditingAuto, x5, y5
    .ConvertToShape
End With

End Sub

Dire « Merci » 3

Quelques mots de remerciements seront grandement appréciés. Ajouter un commentaire

Codes Sources 99 internautes nous ont dit merci ce mois-ci

Commenter la réponse de akasha21
Messages postés
7668
Date d'inscription
samedi 5 novembre 2005
Dernière intervention
22 août 2014
0
Merci
Bonjour,
Tu ne peux tout simplement pas faire celà  de façon simple (raison : absence de hdc de ta Form sous VBA).
Commenter la réponse de jmfmarques
Messages postés
14
Date d'inscription
vendredi 11 mai 2007
Dernière intervention
22 août 2007
0
Merci
lol ok
il n'y a bien que les tuteurs de stages pour donner des trucs tordus à faire!!
Commenter la réponse de akasha21
Messages postés
3181
Date d'inscription
dimanche 15 février 2004
Dernière intervention
9 avril 2017
0
Merci
Salut,



Fait, quelques recherches, tu obtiendras une solution pour obtenir l'hwnd de ton formulaire.
D'autre recherche te permettront de déterminer l'hdc depuis l'hwnd.



__________
 Kenji
Commenter la réponse de Charles Racaud
Messages postés
7668
Date d'inscription
samedi 5 novembre 2005
Dernière intervention
22 août 2014
0
Merci
Je n'ai pas VBA et ne peux donc vérifier si ceci marche ... pauvre de moi...

Mais toi oui :

(je cherche la fenêtre en 1er plan et, quand je l'ai, j'en extrais le hdc (je crois...) en cliquant sur command1

Private Declare Function GetForegroundWindow Lib "user32" () As Long
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long


Private Sub Command1_Click()
  Do While monhdc = 0
    monhdc = GetForegroundWindow()
    monhdc = GetDC(monhdc)
  Loop
  MsgBox monhdc
End Sub

Ce n'est là qu'une tentative modeste d'un aveugle absolu (puisque je ne peux essayer !)
Essaye et dis-moi (çà m'intéresse quand même de savoir si cela va sous VBA)...
Commenter la réponse de jmfmarques
Messages postés
884
Date d'inscription
vendredi 3 novembre 2000
Dernière intervention
3 mars 2009
0
Merci
Mouais, j'avais dja essayé de récupérer le handle d'un userform vba afin de dessiner dessus pour faire des petits jeux où du directx sur les pc de mon ancienne école secondaire et je n'étais arrivé à aucun résultat, il y avait sans cesse des plantage...
Si tu arrive à quelque chose ca m'intéresse !

Julien.
Commenter la réponse de Julien237
Messages postés
500
Date d'inscription
jeudi 5 avril 2007
Dernière intervention
2 juillet 2012
0
Merci
bonjour à tous,
quelques essais et Youpiii, 

Private Declare Function GetForegroundWindow Lib "user32" () As Long
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private MonHdc As Long
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 Declare Function ArcTo 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


Je l'ai mis dans l'évènement activer par facilité, mais comme cela la courbe se redessine à chaque fois. Voir pour la mettre dans ThisWorkbook




Private Sub Worksheet_Activate()
Dim B As Long
MonHdc = 0
  Do While MonHdc = 0
    MonHdc = GetForegroundWindow()
    B = MonHdc
    MonHdc = GetDC(MonHdc)
  Loop
  Range("A1").Value = B
  Range("B1").Value = MonHdc
 
    B = Arc(MonHdc, 120, 500, 320, 400, 320, 400, 780, 500)
End Sub
Evidemment les points sont à adaptés, mais l'arc se dessine bien sur la feuille


Salut jmfmarques , ton idée est la bonne.
A+
louis
Commenter la réponse de cs_lermite222
Messages postés
884
Date d'inscription
vendredi 3 novembre 2000
Dernière intervention
3 mars 2009
0
Merci
Mmh j'avais pas du chercher très longtemps dans ma jeunesse ainsi ^^
Merci et pense à valider les réponses de jmfmarques et kenji !

<hr width="100%" size="2" />Julien.
Commenter la réponse de Julien237
Messages postés
500
Date d'inscription
jeudi 5 avril 2007
Dernière intervention
2 juillet 2012
0
Merci
Mouais........ mais ca ne marche qu'à moitié.
le dessin suis la feuille dans les mouvements de déplacement, mais si la feuille est déplacée plus loin que le dessin et qu'elle revient à l'emplacement d'origine le dessin est disparu, idem si changement de feuille.
Peut donc servir dans une feuille figée (scrool enlevés) et la fonction mise dans activeSheet 
a+
louis


PS: reste encore à trouver les API pour la couleur et l'épaisseur.
Commenter la réponse de cs_lermite222
Messages postés
7668
Date d'inscription
samedi 5 novembre 2005
Dernière intervention
22 août 2014
0
Merci
Etape par étape, Lermitte222, si tu veux bien...
J'attends que réagisse akasha21...


J'espère que tu te rends compte que, dans cette affaire (puisque je ne possède pas VBA), je vais devoir travailler totalement "en aveugle" ?


Tu as un avantage sur moi : tu as VBA ...

Tu peux alors peut-être, te lancer le défi de tenter d'y parvenir, non (en profitant de ton avantage) ? Ca te dit ?
Su oui : welcome to the club ...
Commenter la réponse de jmfmarques
Messages postés
7668
Date d'inscription
samedi 5 novembre 2005
Dernière intervention
22 août 2014
0
Merci
Tiens lermitte, si tu veux te rendre utile dans ma recherche "à l'aveugle" :
Dis-moi donc quels sont les scalemode possibles d'une Userform sous VBA, s'il te plait...
Toi ou un autre...
J'ai besoin de le savoir.
Commenter la réponse de jmfmarques
Messages postés
3181
Date d'inscription
dimanche 15 février 2004
Dernière intervention
9 avril 2017
0
Merci
VBA, ... ScaleMode, que nénie.
Pas de ScaleMode en VBA ; Tout en points.






__________
Kenji

(


Commenter la réponse de Charles Racaud
Messages postés
7668
Date d'inscription
samedi 5 novembre 2005
Dernière intervention
22 août 2014
0
Merci
Ben voilà, Charles, MERCI pour cette information primordiale ...
Points ? Tout en points ?
C'est un Scalemode, çà !

Je réfléchis et reviens....
Tu veux me servir d'yeux pour essayer et me dire ? (je n'ai pas VBA) ...
Tu veux bien ?
Si oui, je reviens dans moins de 10 minutes avec un essai à te faire faire ...
Dis-moi ....
Commenter la réponse de jmfmarques
Messages postés
3181
Date d'inscription
dimanche 15 février 2004
Dernière intervention
9 avril 2017
0
Merci
Allez, mon Excel va être ton cobaye. Ne le tue pas par contre
J'attend les instructions.







__________
Kenji

(


Commenter la réponse de Charles Racaud
Messages postés
7668
Date d'inscription
samedi 5 novembre 2005
Dernière intervention
22 août 2014
0
Merci
Hé !
DING DING DING ! Plus personne ?
Bip bip ...

Bon alors, qui veut bien me servir d'yeux avec ce code à mettre dans un userforim

Const PS_SOLID = 0
Private Type POINTAPI
  X As Long
  Y As Long
End Type
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function GetForegroundWindow Lib "user32" () As Long
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function SetPixelV Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal crColor As Long) As Byte
Private monhdc As Long


Private Sub form _MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  Do While monhdc = 0
        monhdc = GetForegroundWindow()
        monhdc = GetDC(monhdc)
    Loop
 If Button <> 1 Then Exit Sub
   SetPixelV monhdc, X * 1.32, Y * 1.32, RGB(255, 0, 0)
   DoEvents
End Sub

1) changer Form par ce qui convient sous VBA (je crois que c'est UserForm...)
2) lancer
3) dessiner ( lentement à ce stade s'il vous plait) avec le bouton gauche de la souris gardé enfonce
4) me dore siu quelquechose se dessine et si c'est bien en rouge.

Merci à celui qui voudra bien essayer et me rapporter ce qu'il voit (ou non...)...

Je suis vraiment malheureux de ne pas avoir VBA... pour tester moi-même.
Commenter la réponse de jmfmarques
Messages postés
7668
Date d'inscription
samedi 5 novembre 2005
Dernière intervention
22 août 2014
0
Merci
Ah t'es là ...
Merci.
Commenter la réponse de jmfmarques
Messages postés
3181
Date d'inscription
dimanche 15 février 2004
Dernière intervention
9 avril 2017
0
Merci
Résutat du teste :
Ca dessine des p'tit points rouges sous la souris, hihi ^^
Ma form a la varicelle maintenant.

Le code est parfait, tout marche nickel pour l'instant.







__________
Kenji

(


Commenter la réponse de Charles Racaud
Messages postés
7668
Date d'inscription
samedi 5 novembre 2005
Dernière intervention
22 août 2014
0
Merci
Merci Charles,

on tient donc le "bon bout" apparemment...
Je vais donc avoir du boulot sur la planche pour peaufiner tout celà (je sais que ce ne sera pas facile, mais je suis un entêté de première catégorie)...
Je reviendrai donc sur ce post après un dur labeur (combien de temps ? je n'en ai encore aucune idée... mais ne vais pas lacher... ce n'est pas dans mes habitudes).

Merci d'avoir bien voulu essayer et me rapporter.
Merci également pour cette bonne nouvelle.

Jacques Marqués
Commenter la réponse de jmfmarques
Messages postés
7668
Date d'inscription
samedi 5 novembre 2005
Dernière intervention
22 août 2014
0
Merci
Allez, Charles, si tu veux bien,

on va maintenant tenter autre chose (ce ne sera plus la varicelle met une peur verte, peut-petre)

Peux-tu maintenant essayer ceci (avant d'aller dormir) ? C'est la 2ème étape...

Const PS_SOLID = 0
Private Type POINTAPI
  X As Long
  Y As Long
End Type
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function GetForegroundWindow Lib "user32" () As Long
Private Declare Function CreatePen Lib "gdi32" (ByVal nPenStyle As Long, ByVal nWidth As Long, ByVal crColor As Long) As Long
Private Declare Function LineTo Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long) As Long


Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function SetPixelV Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal crColor As Long) As Byte
Private monhdc As Long


Private Sub form _MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
   Do While monhdc = 0
        monhdc = GetForegroundWindow()
        monhdc = GetDC(monhdc)
    Loop
   If Button <> 1 Then Exit Sub
   hRPen = CreatePen(PS_SOLID, 10, RGB(0, 255, 0))
   DeleteObject SelectObject(Me.hdc, hRPen)
   LineTo Me.hdc, X * 1.32, Y * 1.32
   DoEvents
End Sub

Et me dire

(j'abuse de toi, hein ?... pardonne-moi...)


 
Commenter la réponse de jmfmarques

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.