Re : modifier un dessin
je voulais savoir ou je pouvais changer l'echelle?
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Me.Range("B11:B26")) Then
Dim Dessin As Shape
Dim X As Integer, Y As Integer, Alpha As Integer
Dim D As Double, R As Double
Dim PI As Double
PI = 3.14159265358979
'Suppression de l'ancien dessin
On Error Resume Next
Me.Shapes("Tube").Delete
Me.Shapes("Angle0").Delete
Me.Shapes("AngleAlpha").Delete
On Error GoTo 0
'Origine du tube
X = 300
Y = 300
'Diametre et rayon du tube
D = Me.Range("B2").Value / 3
R = D / 2
'Angle
Alpha = Me.Range("B3").Value + 90
'Dessin du tube
Set Dessin = Me.Shapes.AddShape(msoShapeOval, X - R, Y - R, D, D)
Dessin.Name = "Tube"
'Dessin de l'angle 0°
Set Dessin = Me.Shapes.AddLine(X, Y + R, X, Y + R + 50)
Dessin.Name = "Angle0"
'Dessin de l'angle Alpha °
Set Dessin = Me.Shapes.AddLine(X + R * Cos(Alpha * PI / 180), Y + R * (Sin(Alpha * PI / 180)), X + (R + 50) * Cos(Alpha * PI / 180), Y + (R + 50) * (Sin(Alpha * PI / 180)))
Dessin.Name = "AngleAlpha"
End If
End Sub
