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

Question

Posez votre question Signaler

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

akasha21

Messages postés: 14
Date d'inscription: vendredi 11 mai 2007
Dernière intervention: 22 août 2007

- 1 juin 2007 à 15:07 - 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

Visual Basic 6 Posez votre question Signaler

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

A voir également:

Votre réponse

Répondre au sujet

20/38 réponses

Signaler Commenter la réponse de akasha21

akasha21

Messages postés: 14
Date d'inscription: vendredi 11 mai 2007
Dernière intervention: 22 août 2007

5 juin 2007 à 14:57

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

Signaler Commenter la réponse de jmfmarques

jmfmarques

Messages postés: 7668
Date d'inscription: samedi 5 novembre 2005
Dernière intervention: 22 août 2014

1 juin 2007 à 15:17

0

Merci

Bonjour,
Tu ne peux tout simplement pas faire celà de façon simple (raison : absence de hdc de ta Form sous VBA).

Signaler Commenter la réponse de akasha21

akasha21

Messages postés: 14
Date d'inscription: vendredi 11 mai 2007
Dernière intervention: 22 août 2007

1 juin 2007 à 15:24

0

Merci

lol ok
il n'y a bien que les tuteurs de stages pour donner des trucs tordus à faire!!

Signaler Commenter la réponse de Charles Racaud

Charles Racaud

Messages postés: 3181
Date d'inscription: dimanche 15 février 2004
Dernière intervention: 9 avril 2017

1 juin 2007 à 15:27

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

Signaler Commenter la réponse de jmfmarques

jmfmarques

Messages postés: 7668
Date d'inscription: samedi 5 novembre 2005
Dernière intervention: 22 août 2014

1 juin 2007 à 15:57

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

Signaler Commenter la réponse de Julien237

Julien237

Messages postés: 884
Date d'inscription: vendredi 3 novembre 2000
Dernière intervention: 3 mars 2009

1 juin 2007 à 19:27

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.

Signaler Commenter la réponse de cs_lermite222

cs_lermite222

Messages postés: 500
Date d'inscription: jeudi 5 avril 2007
Dernière intervention: 2 juillet 2012

2 juin 2007 à 16:45

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

Signaler Commenter la réponse de Julien237

Julien237

Messages postés: 884
Date d'inscription: vendredi 3 novembre 2000
Dernière intervention: 3 mars 2009

2 juin 2007 à 20:01

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.

Signaler Commenter la réponse de cs_lermite222

cs_lermite222

Messages postés: 500
Date d'inscription: jeudi 5 avril 2007
Dernière intervention: 2 juillet 2012

2 juin 2007 à 21:32

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.

Signaler Commenter la réponse de jmfmarques

jmfmarques

Messages postés: 7668
Date d'inscription: samedi 5 novembre 2005
Dernière intervention: 22 août 2014

2 juin 2007 à 22:08

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

Signaler Commenter la réponse de jmfmarques

jmfmarques

Messages postés: 7668
Date d'inscription: samedi 5 novembre 2005
Dernière intervention: 22 août 2014

2 juin 2007 à 22:16

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.

Signaler Commenter la réponse de Charles Racaud

Charles Racaud

Messages postés: 3181
Date d'inscription: dimanche 15 février 2004
Dernière intervention: 9 avril 2017

2 juin 2007 à 22:31

0

Merci

VBA, ... ScaleMode, que nénie.
Pas de ScaleMode en VBA ; Tout en points.

__________
Kenji

(

Signaler Commenter la réponse de jmfmarques

jmfmarques

Messages postés: 7668
Date d'inscription: samedi 5 novembre 2005
Dernière intervention: 22 août 2014

2 juin 2007 à 22:37

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

Signaler Commenter la réponse de Charles Racaud

Charles Racaud

Messages postés: 3181
Date d'inscription: dimanche 15 février 2004
Dernière intervention: 9 avril 2017

2 juin 2007 à 22:47

0

Merci

Allez, mon Excel va être ton cobaye. Ne le tue pas par contre
J'attend les instructions.

__________
Kenji

(

Signaler Commenter la réponse de jmfmarques

jmfmarques

Messages postés: 7668
Date d'inscription: samedi 5 novembre 2005
Dernière intervention: 22 août 2014

2 juin 2007 à 22:51

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.

Signaler Commenter la réponse de jmfmarques

jmfmarques

Messages postés: 7668
Date d'inscription: samedi 5 novembre 2005
Dernière intervention: 22 août 2014

2 juin 2007 à 22:52

0

Merci

Ah t'es là ...
Merci.

Signaler Commenter la réponse de Charles Racaud

Charles Racaud

Messages postés: 3181
Date d'inscription: dimanche 15 février 2004
Dernière intervention: 9 avril 2017

2 juin 2007 à 22:55

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

(

Signaler Commenter la réponse de jmfmarques

jmfmarques

Messages postés: 7668
Date d'inscription: samedi 5 novembre 2005
Dernière intervention: 22 août 2014

2 juin 2007 à 23:00

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

Signaler Commenter la réponse de jmfmarques

jmfmarques

Messages postés: 7668
Date d'inscription: samedi 5 novembre 2005
Dernière intervention: 22 août 2014

2 juin 2007 à 23:21

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

Votre réponse

Répondre au sujet

Posez votre question

1 2 Suivant

Satanas09 · Accepted Answer · 2007-06-02T23:27:37+0200

Meilleure réponse

Signaler Commenter la réponse de Satanas09

Satanas09

Messages postés: 18
Date d'inscription: samedi 2 juin 2007
Dernière intervention: 22 août 2008

2 juin 2007 à 23:27

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

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

Votre réponse

Votre réponse

Votre réponse

Vous n'êtes pas encore membre ? inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Vous n'êtes pas encore membre ?

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