Tracer demi cercle graphique excel VBA [Résolu]

chevalier78 2 Messages postés samedi 13 décembre 2008Date d'inscription 22 décembre 2008 Dernière intervention - 13 déc. 2008 à 10:23 - Dernière réponse : piloulac 21 Messages postés dimanche 10 juin 2007Date d'inscription 28 décembre 2008 Dernière intervention
- 28 déc. 2008 à 17:39
Bonjour
voilà je voudrai créer un graphique  dont je positionne sur l'abscisse deux points  qui constituent mon diametre du demi cercle que je veux tracer dans le graphique
Comment réaliser ce demicercle entre Pt1 sur l'abscisse et le Pt2 sur cette meme abscisse.
puis de l'origine 0,0 je veux qu'une droite se trace jusqu'a toucher  le précedent demi cercle
Y aurait il quelqu'un de  m'aider

Patrick L
POA
Afficher la suite 

Votre réponse

7 réponses

Meilleure réponse
cs_Orohena 578 Messages postés vendredi 26 septembre 2008Date d'inscription 20 novembre 2010 Dernière intervention - 13 déc. 2008 à 14:08
3
Merci
Pour le dessin du demi-cercle, peux-tu essayer le code suivant ?

Ne sachant quel demi-cercle tu veux afficher, je te donne les deux possibilités.

Option Explicit
Type coordonnees
    x As Double
    y As Double
End TypeConst SUPERIEUR 1, INFERIEUR 2
'
Sub essai()
    Dim Pt1 As coordonnees
    Dim Pt2 As coordonnees    Pt1.x 100: Pt1.y 200                           ' coordonnées du point Pt1    Pt2.x 200: Pt2.y Pt1.x                         ' coordonnées du point Pt2
    trace_Demi_Cercle INFERIEUR, Pt1, Pt2    ' dessin du demi-cercle inférieur de diamètre Pt1, Pt2
End Sub
'
Sub trace_Demi_Cercle(ByVal lequel As Long, ByRef Pt1 As coordonnees, ByRef Pt2 As coordonnees)
    Dim centre As coordonnees, rayon As Double    centre.x (Pt2.x + Pt1.x) / 2: centre.y Pt1.y
    rayon = Abs(Pt2.x - Pt1.x)
    ActiveSheet.Shapes.AddShape(msoShapeArc, _
        centre.x, centre.y - rayon, rayon, rayon).Select
    With Selection
        .ShapeRange.Adjustments.Item(1) = 180
        If lequel = INFERIEUR Then
            .ShapeRange.Flip msoFlipVertical
            .Top = .Top + rayon
        End If
    End With
End Sub

Amicalement

Merci cs_Orohena 3

Avec quelques mots c'est encore mieux Ajouter un commentaire

Codes Sources a aidé 75 internautes ce mois-ci

Commenter la réponse de cs_Orohena
Meilleure réponse
cs_Orohena 578 Messages postés vendredi 26 septembre 2008Date d'inscription 20 novembre 2010 Dernière intervention - 13 déc. 2008 à 14:16
3
Merci
Aïe, j'ai appelé une variable rayon, alors qu'elle aurait dû s'appeler diametre pour une meilleure clarté.

Merci cs_Orohena 3

Avec quelques mots c'est encore mieux Ajouter un commentaire

Codes Sources a aidé 75 internautes ce mois-ci

Commenter la réponse de cs_Orohena
cs_Orohena 578 Messages postés vendredi 26 septembre 2008Date d'inscription 20 novembre 2010 Dernière intervention - 13 déc. 2008 à 13:14
0
Merci
Bonjour chevalier78

l'origine 0, 0 de quoi ?

Cordialement
Commenter la réponse de cs_Orohena
cs_Orohena 578 Messages postés vendredi 26 septembre 2008Date d'inscription 20 novembre 2010 Dernière intervention - 13 déc. 2008 à 21:52
0
Merci
Hello Patrick

>> puis de l'origine 0,0 je veux qu'une droite se trace jusqu'a toucher  le précedent demi cercle

Tu as résolu cette question ? Si oui, peux-tu poster ta solution ?

Si non, précise-moi à quelle origine tu fais référence : celle de ton plan x, y ou celle de la feuille de calcul (coin supérieur gauche).

Amicalement
Commenter la réponse de cs_Orohena
chevalier78 2 Messages postés samedi 13 décembre 2008Date d'inscription 22 décembre 2008 Dernière intervention - 22 déc. 2008 à 10:27
0
Merci
Bonjour
Non a ce jour je n'ai pas trouvé la réponse pour tracer cette droite qui part du point x=0 et y=0  croisé de l' absisse et ordonnée. et qui viens rejoindre le cercle en tangeante en quelque sorte.

 en resumé le cercle se positionne sur l'axe des abcisse  dont le centre passe sur celle ci
en fonction du diamètre  et de sa position origine ex: y=0, x=50 (centre)
une droite doit etre tracée entre le point d'origine 0,0  et va toucher  en biais en montant le cercle  en un point .
Pas evident  a expliquer
Mais  merci quand même.

Patrick L
POA
Commenter la réponse de chevalier78
cs_Orohena 578 Messages postés vendredi 26 septembre 2008Date d'inscription 20 novembre 2010 Dernière intervention - 22 déc. 2008 à 19:52
0
Merci
Bonjour Patrick

C'est bien clair.
C'est un simple problème de trigo. Le triangle formé par la tangente, le rayon et l'axe des x est rectangle au point de tangence, ok ? Tu connais l'hypothénuse (abcisse du centre du cercle) et le côté opposé (rayon). Par conséquent, il t'est facile de calculer l'angle de la tangente.
Une fois connu l'angle, tu as juste à tracer un segment confondu avec l'axe des x et lui faire faire une rotation.
Je te laisse essayer, dis-moi si ça coince.

Amicalement
Commenter la réponse de cs_Orohena
piloulac 21 Messages postés dimanche 10 juin 2007Date d'inscription 28 décembre 2008 Dernière intervention - 28 déc. 2008 à 17:39
0
Merci
Tu colles ces deux Subs dans un module puis tu lances la première DrawGraphTangente.
Dans les InputBox, tu donnes les cotes du cercle et de son écart à l'origine du graphe. (En pixels, ne dépasse pas 300) (L'écart du cercle à l'origine doit être significatif minimum 25 pixels)

Sub DrawGraphTangente()
nettoyerfeuille
Range("A1").Select


Dim x, y, A, B, angleorigine, anglecentre, ytangente, xtangente
Dim Dwg     As Object
Dim AngleD   As Single  'angles degrés
Dim AngleR  As Single   'en radians


B = InputBox("Rayon en pixels de 25 à 300")
If IsNumeric(B) = False Then Exit Sub
A = InputBox("Ecart par rapport à l'origine de 25 à 300")
If IsNumeric(A) = False Then Exit Sub
B = CInt(B)
A = CInt(A)
  
D = A + B       'distance centre/origine


X0 = 50 + D  'x origine
Y0 = 50            'y origin
Range("A1").Select
With ActiveSheet
For AngleD = 2 To 180 Step 2     'Degrees
        AngleR = Application.Radians(AngleD)
        x = B * Cos(AngleR) + X0
        y = B * Sin(AngleR) + Y0
            If AngleD = 2 Then
                'premier pas du cercle
                Set Dwg = .Drawings.Add(B + X0, Y0, x, y, True)
                Dwg.Interior.ColorIndex = xlNone
            Else
                'Add a vertex
                Dwg.AddVertex x, y
            End If
Next AngleD
End With
''grands axes
ActiveSheet.Shapes.AddLine(50, 50, 600, 50).Select
Selection.ShapeRange.Line.EndArrowheadStyle = msoArrowheadTriangle
ActiveSheet.Shapes.AddLine(50, 50, 50, 400).Select
Selection.ShapeRange.Line.EndArrowheadStyle = msoArrowheadTriangle


'''' Un peu de trigo pour tracer la tangente
angleorigine = Application.WorksheetFunction.Asin(B / D)
angleorigine = Application.WorksheetFunction.Degrees(angleorigine)
anglecentre = 90 - angleorigine
anglecentre = Application.WorksheetFunction.Radians(anglecentre)
hauttangente = Sin(anglecentre)
hauttangente = hauttangente * B
hauttangente = hauttangente + 50
ecarttangente = Cos(anglecentre)
ecarttangente = ecarttangente * B
ecarttangente = 50 + A + B - ecarttangente
''tangente
ActiveSheet.Shapes.AddLine(50, 50, ecarttangente, hauttangente).Select
'''projections sur axes
ActiveSheet.Shapes.AddLine(ecarttangente, 50, ecarttangente, hauttangente).Select
 Selection.ShapeRange.Line.ForeColor.SchemeColor = 10
   Selection.ShapeRange.Line.Weight = 1.5
ActiveSheet.Shapes.AddLine(50, hauttangente, ecarttangente, hauttangente).Select
 Selection.ShapeRange.Line.ForeColor.SchemeColor = 48
   Selection.ShapeRange.Line.Weight = 1.5

''''des infos en cellules
Range("A1").Formula = "Rayon"
Range("B1").Formula = B
Range("A2").Formula = "Distance OC"
Range("B2").Formula = D
ecarttangente = Format(ecarttangente, "# ##0.00")
Range("E1").Formula = "X " & ecarttangente
hauttangente = Format(hauttangente, "# ##0.00")
Range("E2").Formula = "Y " & hauttangente
Range("A1").Select
End Sub


Sub nettoyerfeuille()
'''supprimer toutes les lignes de graph
ActiveSheet.DrawingObjects.Select
    Selection.Delete


'' quelques formats
ActiveSheet.Cells.Clear
Range("E1").Font.FontStyle = "Gras"
Range("E1").Font.ColorIndex = 5
Range("E2").Font.FontStyle = "Gras"
Range("E2").Font.ColorIndex = 3        
   
''créer un bouton de commande
 ActiveSheet.Buttons.Add(640.5, 11.25, 51.75, 20.25).Select
    Selection.Characters.Text = "Graph"
    Selection.Name = "Boutongraph"
    Selection.OnAction = "DrawGraphTangente"
End Sub
Commenter la réponse de piloulac

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.