arc de cercle dans une feuille excelRésolu

Question

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

Satanas09 · Accepted Answer

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

cs_lermite222 · Answer

salut jmfmarques, comme celà tu pourras continuer tes déductions "en aveugle" sur le VBA  

A+
louis

jmfmarques · Answer

Merci Lermitte, mais tu es seul à pouvoir voir ton image jointe.
Si tu ne la déposes pas sur un lien (en le donnant) tu seras seul à la voir ...et nul autre ...

Ou dis-moi ce que tu as vu, alors (je comprends tout ce qu'on me rapporte, tu sais... pas besoin d'image )...
Merci

jmfmarques · Answer

Bon ... fatigué...
Bonne nuit à tous et à demain... vais au dodo...

Utilisateur anonyme · Answer

J'allais faillit te dire :
Raah, ca marche pas
mais je me suis aperçu que j'avais oublier de remplacer la déclaration du Form_MouseMove.

Donc, oui, allez les verts.



(T'avais aussi mis des me.hdc au lieu de monhdc)





__________
Kenji

(

cs_lermite222 · Answer

aller... C'est moi qui me dévoue  
ca fonctionne nickel, grosse ligne verte.
seul changement..
Private Sub UserForm_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal 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(monhdc, hRPen)
   LineTo monhdc, X * 1.32, Y * 1.32
   DoEvents


mais de toute facon, même en VB6 ce devrait être comme celà puisque ca ne fonctionne que quand tu est sur la forme, donc la feuille est active.
End Sub
A +
louis

cs_lermite222 · Answer

Petit problème, la ligne démarre toujour de 0 (le coin gauche) ensuite si tu lâche la souris et que tu recommence sur un autre point le trait par toujour du dernier point dessiner.
C'est a cause de la fonction LineTO, j'ai essayé avec setPixel mais le dernier point n'est pas pris en compte, j'ai aussi chercher après une fonction Line (quite à mettre les mêmes donnée dans la 2ém partie), mais dans gdi32 j'ai rien trouver qui y ressemble.
Ca serrait mieux si la ligne démarrait à partir du point (tient point, j'y ai pas pensé) je continuerais demain.
Si quelqu'un connait une dll qui fait cà....merci de nous la communiqué.
A+
louis

Utilisateur anonyme · Answer

Salut,

L'api est MoveToEx :





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 MoveToEx Lib "gdi32" (ByVal hdc As Long, _
  ByVal X As Long, ByVal Y As Long, lpPoint As Any) 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 UserForm_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, _
  ByVal X As Single, ByVal Y As Single)
  Static Toto As Boolean
  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(monhdc, hRPen)
  If Toto = False Then
    MoveToEx monhdc, X * 1.32, Y * 1.32, &H0
    Toto = True
  End If
  LineTo monhdc, X * 1.32, Y * 1.32
  DoEvents
End Sub ,

----

(

jmfmarques · Answer

Bonjour, Charles,

Oui, c'est MoveToEx qui répond le mieux.

Mais le plus important est que tu te sois pris à ce jeu-là. Lermitte aussi.

J'en suis très content pour mille et une raisons :
- la toute première : je sais maintenant qye c'est bien parti, que je ne serai pas seul et que nous y parviendrons donc
- la deuxième est qu'il s'agit là d'un bon exercice et qu'il sera utile à plus d'un
- la troisième est que celà va (je l'espère) faire des adeptes et i_ls seront les bienvenues

La seule question qui va maintenant se poser est celle du risque (grand) de polluer ce forum avec nos tests successifs (car les échanges devront, je le devine, être nombreux).

Question donc aux administrateurs : 
 que faisons-nous ? 
1) on continue ici ? celà permettrait la participation d'un plus grand nombre d'avertis mais polluerait assez sérieusement le forum.
2) on continue par MP pour éviter la pollution ?

Il me parait que la réponse d'un admin est ici importante car il ne saurait être question de décider seuls de ce qui est le plus souhaitable ou le moins indésirable.

Julien237 · Answer

Je ne suis pas admin, mais je suis votre discussion avec le plus grand intérêt et je serais déçu que vous continuiez en mp...

<hr width="100%" size="2" />Julien.

jmfmarques · Answer

Merci Julien, d'avoir exprimé ton opinion,

Mais il me semble que ni toi ni moi n'aurions le droit de nous substutuer ici à un administrateur.
Nous ne sommes ni toi ni moi administrateurs et ignorons donc totalement ce qu'il pourrait y avoir "derrière" (les avantages et les inconvénients de chaque aspect)..
Il est dans ce domaine comme dans la plupart des domaines souhaitable de laisser les hommes de l'art (qui savent, eux, les implications et connaissent les conséquences de chaque chose) prendre et nous communiquer la décsion qui leur parait la plus sage (et ce sans même aucune nécessité de nous exposer les raisons de la décision prise). C'est juste une question de discipline !
Si même le vieux galopin que je suis s'y plie, ce n'est sans doute pas sans raisons 
Nous sommes un dimanche, Julien, donne le temps au temps...

cs_lermite222 · Answer

Bonjour à tous,
Et bien.. pas de réaction à ton message précédant, je dirais donc : Ce qui n'est pas interdit est permis..
J'attendrais donc ta relance.
Mais en attendant,
  If Toto = False Then
    MoveToEx monhdc, X * 1.32, Y * 1.32, &H0
    Toto = True
  End If
devrait être
  If Toto Then
    MoveToEx monhdc, X * 1.32, Y * 1.32, &H0
    Toto = false
  End If

Permet de resaisir un nouveau point à chaque clic
Private Sub UserForm_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Toto = True
End Sub
tester et tout est maintenad OK
Autre chose ?

A+
louis

jmfmarques · Answer

Boinjour Lermitte,

Oui (j'ai fait à peu près la même chose) : toto non statique mais globale et j'utilise plutôt le mouseup (mais le MouseUp est-il reconnu par VBA ?)
J'en suis en réalité déjà aux interfaces nécessaires de paramètrage d'une structure "brosse" (c'est presque terminé, en ce qui concerne le principe).
Par contre : VBA accepte-il les "menus" (sous la barre de titre ?) et leur édition, puis leur appel par click, est-elle différente de celle de VB6 ?
Si oui : les "items" des menus acceptent-il le signe  pour établir des raccourcis ?
Enfin : peux-tu me faire parvenir par MP (ce n'est pas du code) toutes les propriétés d'un UserForm et un inventaire de ses méthodes  sous VBA ? (juste pour voir si je ne peux m'en servir pour "figer" plutôt que de passer par du plus complexe... on ne sait jamais).
Enfin : une autre question : Existe-t-il sous VBA une propriété image (comme dans VB6) ? Je dis bien propriété et non contrôle .

cs_lermite222 · Answer

Bonjour à tous,
Salut jmfmarque
1°) il y a une propriété picture sur un UF


2°Sur un UF il n'y a pas de barre de titre ni de menu possible.
Mais tu peu ajouter une Toolbaar avec bouton et menu  + ImageList
Le TB supporte les raccourcis (si mes souvenirs sont bons)
Pour les propriétés UC je vais copier l'image (hi) sur mon site (fermer) et te mettrais l'URL dans un MP. (pour le moment pas moyen d'y accéder ??)
A+
louis

cs_lermite222 · Answer

Les évènements sont (j'ai oublié)
EV Key : oui
EV Mouse : oui
Activate/deactivate
Addcontrol /removeControle
Zoom (j'ai jamais employé)
query et resize.
UserForm_Initialize: UserForm_Error
Private Sub UserForm_BeforeDropOrPaste(ByVal Cancel As MSForms.ReturnBoolean, ByVal Control As MSForms.Control, ByVal Action As MSForms.fmAction, ByVal Data As MSForms.DataObject, ByVal X As Single, ByVal Y As Single, ByVal Effect As MSForms.ReturnEffect, ByVal Shift As Integer)

Private Sub UserForm_BeforeDragOver(ByVal Cancel As MSForms.ReturnBoolean, ByVal Control As MSForms.Control, ByVal Data As MSForms.DataObject, ByVal X As Single, ByVal Y As Single, ByVal State As MSForms.fmDragState, ByVal Effect As MSForms.ReturnEffect, ByVal Shift As Integer)
il y a encore d'autre évènements mais je ne connais pas leurs fonctions, j'y reviendrais si nécessaire ou pour un équivalent.

akasha21 · Answer

bonjour, désolée de ne pas vous avoir aidés, je n'ai pas eu accès à internet ce we.

Merci du mal que vous vous donnez et si je peux essayer quelque chose, dites-moi (mais je vous previens, je suis novice en VBA)

jmfmarques · Answer

Merci akasha, de vouloir aider
Mais je crois que si tu es novice, il vaudrait mieux, dans cette affaire-là, te contenter d'être spectacteur...

Satanas09 · Answer

Bonsoir akasha21...

tu peu toujours répondre à la question que je t'ai posé page précédente:
http://www.vbfrance.com/infomsg_ARC-CERCLE-DANS-FEUILLE-EXCEL_954937.aspx?p=3

et tester ce code ...

Satanas09 ..... Sapristi, saprista, souris grise et face de rat

akasha21 · Answer

Satanas,

en ajoutant 2 noeuds supplémentaires, ça m'a donné un arc de cercle acceptable. merci!

Arc de cercle dans une feuille excel

38 réponses

Votre réponse

Discussions similaires