Discussion :

[emmanuel89500]

Bonjour,
Je n'arrive pas a trouver dans l'aide Excel l'instruction permettant de créer un shape cercle de rayon fixé.
Pouvez-vous m'aider?

Autre petite question : quand on crée un shape, quelles sont les unités? (le pixel?)

Merci!

[ctac_]

Bonjour,

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
 
Sub LeCercle()
Dim Rayon As Single
Rayon = 50
ActiveSheet.Shapes.AddShape msoShapeOval, [C3].Left, [C3].Top, Rayon, Rayon
End Sub

L'unité est le point.

Voir l'aide sur AddShape

ctac

[mercatog]

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
Dim shp As Shape
Dim Xo As Integer, Yo As Integer, R As Integer
 
Xo = 50: Yo = 200: R = 40
Set shp = ActiveSheet.Shapes.AddShape(9, Xo, Yo, R, R)

[AlainTech]

Bonjour,

Une fonction:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
Function Cercle(c As Range, nRadius As Single) As Shape
  ' nRadius in centimeters
  Dim iRadiusInPoints As Long
  iRadiusInPoints = Application.CentimetersToPoints(nRadius)
 
  Set Cercle = c.Parent.Shapes.AddShape(msoShapeOval, _
                                        c.Left, _
                                        c.Top, _
                                        iRadiusInPoints, _
                                        iRadiusInPoints)
End Function

Et son appel:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
Sub TraceCercle()
  Dim shp As Shape
  Set shp = Cercle(ActiveSheet.[C3], 3.5)
End Sub

Idem pour un cercle centré sur les gauche/haut d'une cellule:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Function CercleCentre(c As Range, nRadius As Single) As Shape
  ' nRadius in centimeters
  Dim iRadiusInPoints As Long
  iRadiusInPoints = Application.CentimetersToPoints(nRadius)
  Set CercleCentre = c.Parent.Shapes.AddShape(msoShapeOval, _
                                        c.Left - (iRadiusInPoints / 2), _
                                        c.Top - (iRadiusInPoints / 2), _
                                        iRadiusInPoints, _
                                        iRadiusInPoints)
End Function
 
Sub TraceCercle()
  Dim shp As Shape
  Set shp = CercleCentre(ActiveSheet.[C7], 3.5)
End Sub