Sujet Précédent Sujet Suivant

Tracer cercle vba excel

titeuf136 Messages postés 91 Date d'inscription vendredi 15 janvier 2010 Statut Membre Dernière intervention 19 octobre 2012 - 31 janv. 2010 à 13:41
NHenry Messages postés 15113 Date d'inscription vendredi 14 mars 2003 Statut Modérateur Dernière intervention 22 avril 2024 - 31 janv. 2010 à 16:57
bonjour je souhaite tracer un cercle à l'aide de visual basic
cela fonctionne lorsque je rentre manuellement les données des variables e et f (coordonée du centre). Mais lorsque je fais appel à ces variables, ça ne fonctionne plus

Merci pour votre aide 


Sub tracercle()
ActiveSheet.Shapes.AddShape(msoShapeOval, e, f, 20, 20).Select
End Sub

Sub trace_cercle()
Dim e As String
Dim f As String
e = 20
f = 30
Call tracercle
End Sub

12 réponses

Réponse 1 / 12
titeuf136 Messages postés 91 Date d'inscription vendredi 15 janvier 2010 Statut Membre Dernière intervention 19 octobre 2012 1
31 janv. 2010 à 15:20
ok Merci d'avoir répondu si vite. j'ai appliqué tes instructions, et ça à marché dans un premier temps. J'ai voulu rajouter un paramètre couleur, et depuis ça ne fonctionne plus.

voici ce que j'ai tester (sans couleur) 
Option Explicit

Sub tracercle(ByVal pcentreX As Single, ByVal pcentrey As Single)
    ActiveSheet.Shapes.AddShape(msoShapeOval, pcentreX, pcentrey, 20, 20).Select
End Sub

Sub trace_cercle()
    Dim pcentreX As Single
    Dim pcentrey As Single
    pcentreX = 100
    pcentrey = 100
    Call tracercle
End Sub


et avec couleur. 

Sub tracerclecoul(ByVal pcentreX As Single, ByVal pcentrey As Single, ByRef coul As String)
    ActiveSheet.Shapes.AddShape(msoShapeOval, pcentreX, pcentrey, 20, 20).Select
    Selection.ShapeRange.Fill.ForeColor.RGB = coul
End Sub

Sub trace_cerclecoul()
    Dim pcentreX As Single
    Dim pcentrey As Single
    Dim coul As String
    pcentreX = 60
    pcentrey = 60
    If Cells(1, 1) = "o" Then
    coul = RGB(250, 0, 0)
    Else
    coul = RGB(0, 250, 0)
    End If
    Call tracerclecoul
End Sub
1
Réponse 2 / 12
NHenry Messages postés 15113 Date d'inscription vendredi 14 mars 2003 Statut Modérateur Dernière intervention 22 avril 2024 159
31 janv. 2010 à 14:18
Bonjour,

Ton problème est lié à la portée des variables.
Pense à TOUJOURS mettre "Option Explicit en haut de tes modules de code, cela te force à déclarer tes variables.

Pour faire simple :
Les variables "e" et "f" ne sont valables que dans la Sub trace_cercle.

Il faut utiliser des paramètres pour ça : 
Sub tracercle(Byval pCentreX as single,Byval pCentreY as single)
    ActiveSheet.Shapes.AddShape(msoShapeOval, pCentreX , pCentreY , 20, 20).Select
End Sub

Sub trace_cercle()
    Dim e As Single
    Dim f As Single
    e = 20
    f = 30
    tracercle e,f
End Sub


Evite aussi les types non adaptés, par exemple dans ton code des String pour stocker des nombres, ça t'évitera pas mal d'erreur.

0
Réponse 3 / 12
titeuf136 Messages postés 91 Date d'inscription vendredi 15 janvier 2010 Statut Membre Dernière intervention 19 octobre 2012 1
31 janv. 2010 à 15:29
ok j'ai résolu le pb N°1 sans couleur

j'vais oublier à la fin 
tracercle pcentreX, pcentrey


Mais mon problème pour inclure la paramètre "couleur" demeure toujours.
0
Réponse 4 / 12
titeuf136 Messages postés 91 Date d'inscription vendredi 15 janvier 2010 Statut Membre Dernière intervention 19 octobre 2012 1
31 janv. 2010 à 15:31
finalement plus de problème !

tout est arrangé

MERCI à toi pour ton aide
0

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question
Réponse 5 / 12
NHenry Messages postés 15113 Date d'inscription vendredi 14 mars 2003 Statut Modérateur Dernière intervention 22 avril 2024 159
31 janv. 2010 à 15:35
Bonjour,

Pourquoi tu persévère à faire des données en String à la place du type numérique quand cela est le cas ?
RGB retourne un Long, donc ce n'est pas :
Dim coul As String
Mais
Dim coul As Long

Ensuite, tu n'a pas ajouté le paramètre dans l'appel de la sub.
Tu ajoutes un :
,coul
et ça devrait passer.

Préfère passer les paramètres en ByVal, sauf si cela est absolument nécessaire de passer en ByRef.

0
Réponse 6 / 12
titeuf136 Messages postés 91 Date d'inscription vendredi 15 janvier 2010 Statut Membre Dernière intervention 19 octobre 2012 1
31 janv. 2010 à 16:00
J'essaye à présent de rajouter cette procédure dans une macro qui fonctionnait auparavant.

Le but de cette macro est de tracer successivement des segments en fonction de coordonnées listées dans un tableau.
Les coordonnées manquantes sont matérialisés par la lettre "t", et sont calculés à l'aide des coordonnées du segment connues (qui inclut ce point).

Mon problème est que la macro ne trace ni les segment ni les ploints et affiche le message "erreur de compilation: argument non facultatif"

comment rectifier ce souci?

voici ma macro: 

Option Explicit

Sub traceligne(ByVal a As Single, ByVal b As Single, ByVal a As Single, ByVal d As Single, ByVal c As Single, ByRef coul As String)
'coordonées
    ActiveSheet.Shapes.AddLine(b, a, d, c).Select
'épaisseur
    Selection.ShapeRange.Line.Weight = 3
'couleur
    Selection.ShapeRange.Line.ForeColor.RGB = coul

End Sub

Sub tracerclecoul(ByVal pcentreX As Single, ByVal pcentrey As Single, ByRef coul As String)
'coordonées
    ActiveSheet.Shapes.AddShape(msoShapeOval, pcentreX, pcentrey, 20, 20).Select
'couleur
    Selection.ShapeRange.Fill.ForeColor.RGB = coul
End Sub

Sub graphe()

'incrément_boucle
Dim n As Single
Dim m As Single
'coordonées_segment
Dim a As Single
Dim b As Single
Dim c As Single
Dim d As Single
'coordonées_cercle
Dim pcentreX As Single
Dim pcentrey As Single
Dim coul As String


For n = 2 To 4
a = 0
b = 0
c = 0
d = 0
pcentrey = 0
pcentreX = 0

If Cells(1, n) = "o" Then
coul = RGB(200, 0, 0)
End If
If Cells(1, n) = "t" Then
coul = RGB(0, 200, 0)
End If
If Cells(1, n) = "g" Then
coul = RGB(0, 0, 200)
End If


     For m = 2 To 10
         If Cells(m, n) = "t" Then
         pcentrey = Cells(m, 1)
         End If
         If a = 0 And Cells(m, n) <> "" And Cells(m, n) <> "t" Then
          a = Cells(m, 1)
          b = Cells(m, n)
         End If
         
         If a <> 0 And c = 0 And Cells(m, n) <> "" And Cells(m, n) <> "t" Then
          c = Cells(m, 1)
          d = Cells(m, n)
          traceligne b, a, d, c, coul
         
             If pcentrey <> 0 Then
             pcentreX = CInt(((d - b) / (c - a) * (pcentrey - a)) + b)
             tracerclecoul pcentreX, pcentrey, coul
             End If
             
         End If
         
         If c <> 0 And Cells(m, n) <> "" And Cells(m, n) <> "t" Then
          a = c
          b = d
          c = Cells(m, 1)
          d = Cells(m, n)
          traceligne b, a, d, c, coul
         
             If pcentrey <> 0 Then
             pcentreX = CInt(((d - b) / (c - a) * (pcentrey - a)) + b)
             tracerclecoul pcentreX, pcentrey, coul
             End If
             
         End If
      Next m
Next n
End Sub
0
Réponse 7 / 12
titeuf136 Messages postés 91 Date d'inscription vendredi 15 janvier 2010 Statut Membre Dernière intervention 19 octobre 2012 1
31 janv. 2010 à 16:06
Merci NHenry j'avais pas lu ta réponse précédent, je viens d'en prendre compte dans la suite de ma macro

sauf erreur de ma part cela donne: 

Option Explicit

Sub traceligne(ByVal a As Single, ByVal b As Single, ByVal a As Single, ByVal d As Single, ByVal c As Single, ByVal coul As Long)
'coordonées
    ActiveSheet.Shapes.AddLine(b, a, d, c).Select
'épaisseur
    Selection.ShapeRange.Line.Weight = 3
'couleur
    Selection.ShapeRange.Line.ForeColor.RGB = coul

End Sub

Sub tracerclecoul(ByVal pcentreX As Single, ByVal pcentrey As Single, ByVal coul As Long)
'coordonées
    ActiveSheet.Shapes.AddShape(msoShapeOval, pcentreX, pcentrey, 20, 20).Select
'couleur
    Selection.ShapeRange.Fill.ForeColor.RGB = coul
End Sub

Sub graphe()

'incrément_boucle
Dim n As Single
Dim m As Single
'coordonées_segment
Dim a As Single
Dim b As Single
Dim c As Single
Dim d As Single
'coordonées_cercle
Dim pcentreX As Single
Dim pcentrey As Single
Dim coul As String


For n = 2 To 4
a = 0
b = 0
c = 0
d = 0
pcentrey = 0
pcentreX = 0

If Cells(1, n) = "o" Then
coul = RGB(200, 0, 0)
End If
If Cells(1, n) = "t" Then
coul = RGB(0, 200, 0)
End If
If Cells(1, n) = "g" Then
coul = RGB(0, 0, 200)
End If


     For m = 2 To 10
         If Cells(m, n) = "t" Then
         pcentrey = Cells(m, 1)
         End If
         If a = 0 And Cells(m, n) <> "" And Cells(m, n) <> "t" Then
          a = Cells(m, 1)
          b = Cells(m, n)
         End If
         
         If a <> 0 And c = 0 And Cells(m, n) <> "" And Cells(m, n) <> "t" Then
          c = Cells(m, 1)
          d = Cells(m, n)
          traceligne b, a, d, c, coul
         
             If pcentrey <> 0 Then
             pcentreX = CInt(((d - b) / (c - a) * (pcentrey - a)) + b)
             tracerclecoul pcentreX, pcentrey, coul
             End If
             
         End If
         
         If c <> 0 And Cells(m, n) <> "" And Cells(m, n) <> "t" Then
          a = c
          b = d
          c = Cells(m, 1)
          d = Cells(m, n)
          traceligne b, a, d, c, coul
         
             If pcentrey <> 0 Then
             pcentreX = CInt(((d - b) / (c - a) * (pcentrey - a)) + b)
             tracerclecoul pcentreX, pcentrey, coul
             End If
             
         End If
      Next m
Next n
End Sub


mais le message "erreur de compilation: argument non facultatif" reste présent
0
Réponse 8 / 12
NHenry Messages postés 15113 Date d'inscription vendredi 14 mars 2003 Statut Modérateur Dernière intervention 22 avril 2024 159
31 janv. 2010 à 16:39
Bonjour,

Ta ligne :
Sub traceligne(ByVal a As Single, ByVal b As Single, ByVal a As Single, ByVal d As Single, ByVal c As Single, ByVal coul As Long)

Ne comporte pas une erreur ?

De plus, pense à nommer de manière lisible tes variables.

A quoi servent a, b, c, d ?
Ce sont les points, je suppose, alors pense à les nommer par exemple X1, Y1, X2, Y2, ce sera plus clair. 

Option Explicit

Sub traceligne(ByVal a As Single, ByVal b As Single, ByVal d As Single, ByVal c As Single, ByVal pColor As Long)
    'coordonées
    ActiveSheet.Shapes.AddLine(b, a, d, c).Select
    'épaisseur
    Selection.ShapeRange.Line.Weight = 3
    'couleur
    Selection.ShapeRange.Line.ForeColor.RGB = pColor
End Sub

Sub tracerclecoul(ByVal pCentreX As Single, ByVal pCentrey As Single, ByVal pColor As Long)
    'coordonées
    ActiveSheet.Shapes.AddShape(msoShapeOval, pcentreX, pcentrey, 20, 20).Select
    'couleur
    Selection.ShapeRange.Fill.ForeColor.RGB = pColor
End Sub

Sub graphe()

    'incrément_boucle
    Dim n As Single
    Dim m As Single
    'coordonées_segment
    Dim a As Single
    Dim b As Single
    Dim c As Single
    Dim d As Single
    'coordonées_cercle
    Dim lCentreX As Single
    Dim lCentreY As Single
    Dim lColor As Long

    For n = 2 To 4
        a = 0
        b = 0
        c = 0
        d = 0
        lcentrey = 0
        lcentreX = 0

        If Cells(1, n) = "o" Then
            lColor = RGB(200, 0, 0)
        End If
        If Cells(1, n) = "t" Then
            lColor = RGB(0, 200, 0)
        End If
        If Cells(1, n) = "g" Then
            lColor = RGB(0, 0, 200)
        End If

         For m = 2 To 10
             If Cells(m, n) = "t" Then
                lcentrey = Cells(m, 1)
            End If
            If a = 0 And Cells(m, n) <> "" And Cells(m, n) <> "t" Then
                a = Cells(m, 1)
                b = Cells(m, n)
            End If

            If a <> 0 And c = 0 And Cells(m, n) <> "" And Cells(m, n) <> "t" Then
                c = Cells(m, 1)
                d = Cells(m, n)
                traceligne a, b, d, c, lColor

                If lcentrey <> 0 Then
                    lcentreX = CInt(((d - b) / (c - a) * (lcentrey - a)) + b)
                    tracerclecoul lcentreX, lcentrey, lColor
                End If

            End If

            If c <> 0 And Cells(m, n) <> "" And Cells(m, n) <> "t" Then
                a = c
                b = d
                c = Cells(m, 1)
                d = Cells(m, n)
                traceligne b, a, d, c, lColor

                If lcentrey <> 0 Then
                    lcentreX = CInt(((d - b) / (c - a) * (lcentrey - a)) + b)
                    tracerclecoul lcentreX, lcentrey, lColor
                End If

            End If
        Next m
    Next n
End Sub
0
Réponse 9 / 12
titeuf136 Messages postés 91 Date d'inscription vendredi 15 janvier 2010 Statut Membre Dernière intervention 19 octobre 2012 1
31 janv. 2010 à 16:40
j'ai corrigé la première ligne par 
Sub traceligne(ByVal b As Single, ByVal a As Single, ByVal d As Single, ByVal c As Single, ByVal c As Single, ByVal coul As Long)


mais pas d'améliorations ...
0
Réponse 10 / 12
titeuf136 Messages postés 91 Date d'inscription vendredi 15 janvier 2010 Statut Membre Dernière intervention 19 octobre 2012 1
31 janv. 2010 à 16:55
OK toutes mes excuses j'avais recopier 2 fois la variable C

Tu as bien raison je vais également modifier l'appellation de mes variables j'y verrai bien plus clair.

merci pour ta contribution qui m'est très précieuse.

Je suis encore loin de ce à quoi je souhaite parvenir ... mais ça avance !
0
Réponse 11 / 12
NHenry Messages postés 15113 Date d'inscription vendredi 14 mars 2003 Statut Modérateur Dernière intervention 22 avril 2024 159
31 janv. 2010 à 16:56
Bonjour,

Pourquoi 2 fois le paramètre c ?

0
Réponse 12 / 12
NHenry Messages postés 15113 Date d'inscription vendredi 14 mars 2003 Statut Modérateur Dernière intervention 22 avril 2024 159
31 janv. 2010 à 16:57
Dsl, je n'avais pas vu le message précédent le mien (pas vu qu'il y avait 2 pages)
0

Discussions similaires

Demi-cercle
Talboum -
meb1410 -

3 réponses
Distance entre 2 points sur un cercle
Astro49 -
Astro49 -

26 réponses
Dessiner un arc sans connaitre le centre du cercle
JohnBug -
Galain -

5 réponses
Tracer un cercle plein (un disque quoi)
plhea -
P__ROMEO -

8 réponses
fonction modulo en VBA
krisprolss -
Benouille -

2 réponses
Rejoignez-nous