[HS] Ça roule

Francois

19/08/2005 à 18:47

Bonsoir tout le monde,

Je ne sais pas si l'animation est réaliste mais
les calculs sont corrects. Ça peut servir à
certains profs qui enseignent ce genre de chose.

Je commence à aimer ça, moé, Excel ;-)
A+

Bonsoir,

Joli:-)

Je ne sais pas si c'est utile (la mécanique et moi ...) mais pas grave.
Il ne reste plus à Misange qu'à créer une rubrique "Peut-être utile,
mais en tout cas joli".

Cordialement,

--

François L

Charles Ingals

19/08/2005 à 19:38

Bonsoir,
Un seul mot : superbe.
Très beau travail.
@+ et bonne soirée.
"garnote" a écrit dans le message de news:

Bonsoir tout le monde,

Je ne sais pas si l'animation est réaliste mais
les calculs sont corrects. Ça peut servir à
certains profs qui enseignent ce genre de chose.

Je commence à aimer ça, moé, Excel ;-)
A+

Serge

Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Sub Roulement_A_Billes()
'Application mathématique pour
'les techniques industrielles
'Copiez ces deux macros dans un module standard,
'activez une feuille vierge et appelez
'la macro Roulement_A_Billes.
On Error Resume Next
With Application
.DisplayFullScreen = True
.DisplayFormulaBar = False
End With
With ActiveWindow
.DisplayGridlines = False
.DisplayHeadings = False
End With
Set F = ActiveSheet
F.DrawingObjects.Delete
[A1:C4].ClearContents
[C4].Select
q = InputBox("Entrez le diamètre ( de 100 à 450 ) de la cage" _
& vbLf & "et le nombre de billes ( de 3 à 50 )" _
& vbLf & "séparés par un astérisque.", _
" Roulement à billes", "400 * 10")
If q = "" Then Exit Sub
r = Split(q, "*")
If r(0) < 100 Or r(0) > 450 Then Exit Sub
'Nombre de billes
nb = r(1)
If nb < 3 Or nb > 50 Then Exit Sub
'Centre de la cage
cx1 = 350
cy1 = 240
'Rayon de la cage
gr = r(0) / 2
'Dessine la cage
With F.Shapes.AddShape _
(msoShapeOval, cx1 - gr, cy1 - gr, 2 * gr, 2 * gr)
.Fill.ForeColor.SchemeColor = 22
.Line.Weight = 2
End With
'Angle au centre sous-tendu par
'les tangentes à une des billes
Angle = WorksheetFunction.Radians(360 / nb)
a = Angle / 2
'Rayon des billes
rb = gr * Sin(a) / (1 + Sin(a))
'Dessine les billes
For i = 1 To nb
cx2 = cx1 + (gr - rb) * Cos(2 * i * a)
cy2 = cy1 - (gr - rb) * Sin(2 * i * a)
With F.Shapes.AddShape _
(msoShapeOval, cx2 - rb, cy2 - rb, 2 * rb, 2 * rb)
.Fill.ForeColor.SchemeColor = 1 + Int(56 * Rnd())
.Line.Weight = 1
End With
Next i
With F.DrawingObjects.Group
.Name = "billes"
End With
'Rayon de l'essieu
pr = gr * (1 - Sin(a)) / (1 + Sin(a))
'Dessine l'essieu
With F.Shapes.AddShape _
(msoShapeNoSymbol, cx1 - pr, cy1 - pr, 2 * pr, 2 * pr)
.Fill.ForeColor.SchemeColor = 1 + Int(56 * Rnd())
.Line.Weight = 1
.Name = "essieu"
End With
'Renseignements
[A1] = "Diamètre de la cage :"
[C1] = 2 * gr
[A2] = "Nombre de billes :"
[C2] = nb
[A3] = "Diamètre de l'essieu :"
[C3] = 2 * pr
[A4] = "Diamètre des billes :"
[C4] = 2 * rb
'Appelle la macro Tourne pour l'animation
'Pour annuler l'animation, mettre ' devant Tourne
Tourne
'Groupe le tout
F.DrawingObjects.Group
'garnote, août 2005
End Sub

Sub Tourne()
'Vous pouvez changer ces paramètres
rb = -3
re = 1
s = 20
'Animation
For i = 1 To 360
ActiveSheet.Shapes("billes").IncrementRotation rb
ActiveSheet.Shapes("essieu").IncrementRotation re
DoEvents
Sleep (s)
Next i
End Sub

Bonsoir,
Un seul mot : superbe.
Très beau travail.
@+ et bonne soirée.
"garnote" <rien@absent.com> a écrit dans le message de news:
uuuYWZNpFHA.3036@TK2MSFTNGP14.phx.gbl...

Bonsoir tout le monde,

Je ne sais pas si l'animation est réaliste mais
les calculs sont corrects. Ça peut servir à
certains profs qui enseignent ce genre de chose.

Je commence à aimer ça, moé, Excel ;-)
A+

Serge

Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Sub Roulement_A_Billes()
'Application mathématique pour
'les techniques industrielles
'Copiez ces deux macros dans un module standard,
'activez une feuille vierge et appelez
'la macro Roulement_A_Billes.
On Error Resume Next
With Application
.DisplayFullScreen = True
.DisplayFormulaBar = False
End With
With ActiveWindow
.DisplayGridlines = False
.DisplayHeadings = False
End With
Set F = ActiveSheet
F.DrawingObjects.Delete
[A1:C4].ClearContents
[C4].Select
q = InputBox("Entrez le diamètre ( de 100 à 450 ) de la cage" _
& vbLf & "et le nombre de billes ( de 3 à 50 )" _
& vbLf & "séparés par un astérisque.", _
" Roulement à billes", "400 * 10")
If q = "" Then Exit Sub
r = Split(q, "*")
If r(0) < 100 Or r(0) > 450 Then Exit Sub
'Nombre de billes
nb = r(1)
If nb < 3 Or nb > 50 Then Exit Sub
'Centre de la cage
cx1 = 350
cy1 = 240
'Rayon de la cage
gr = r(0) / 2
'Dessine la cage
With F.Shapes.AddShape _
(msoShapeOval, cx1 - gr, cy1 - gr, 2 * gr, 2 * gr)
.Fill.ForeColor.SchemeColor = 22
.Line.Weight = 2
End With
'Angle au centre sous-tendu par
'les tangentes à une des billes
Angle = WorksheetFunction.Radians(360 / nb)
a = Angle / 2
'Rayon des billes
rb = gr * Sin(a) / (1 + Sin(a))
'Dessine les billes
For i = 1 To nb
cx2 = cx1 + (gr - rb) * Cos(2 * i * a)
cy2 = cy1 - (gr - rb) * Sin(2 * i * a)
With F.Shapes.AddShape _
(msoShapeOval, cx2 - rb, cy2 - rb, 2 * rb, 2 * rb)
.Fill.ForeColor.SchemeColor = 1 + Int(56 * Rnd())
.Line.Weight = 1
End With
Next i
With F.DrawingObjects.Group
.Name = "billes"
End With
'Rayon de l'essieu
pr = gr * (1 - Sin(a)) / (1 + Sin(a))
'Dessine l'essieu
With F.Shapes.AddShape _
(msoShapeNoSymbol, cx1 - pr, cy1 - pr, 2 * pr, 2 * pr)
.Fill.ForeColor.SchemeColor = 1 + Int(56 * Rnd())
.Line.Weight = 1
.Name = "essieu"
End With
'Renseignements
[A1] = "Diamètre de la cage :"
[C1] = 2 * gr
[A2] = "Nombre de billes :"
[C2] = nb
[A3] = "Diamètre de l'essieu :"
[C3] = 2 * pr
[A4] = "Diamètre des billes :"
[C4] = 2 * rb
'Appelle la macro Tourne pour l'animation
'Pour annuler l'animation, mettre ' devant Tourne
Tourne
'Groupe le tout
F.DrawingObjects.Group
'garnote, août 2005
End Sub

Sub Tourne()
'Vous pouvez changer ces paramètres
rb = -3
re = 1
s = 20
'Animation
For i = 1 To 360
ActiveSheet.Shapes("billes").IncrementRotation rb
ActiveSheet.Shapes("essieu").IncrementRotation re
DoEvents
Sleep (s)
Next i
End Sub

Vous avez filtré cet utilisateur ! Consultez son message

Bonsoir,
Un seul mot : superbe.
Très beau travail.
@+ et bonne soirée.
"garnote" a écrit dans le message de news:

Bonsoir tout le monde,

Je ne sais pas si l'animation est réaliste mais
les calculs sont corrects. Ça peut servir à
certains profs qui enseignent ce genre de chose.

Je commence à aimer ça, moé, Excel ;-)
A+

Serge

Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Sub Roulement_A_Billes()
'Application mathématique pour
'les techniques industrielles
'Copiez ces deux macros dans un module standard,
'activez une feuille vierge et appelez
'la macro Roulement_A_Billes.
On Error Resume Next
With Application
.DisplayFullScreen = True
.DisplayFormulaBar = False
End With
With ActiveWindow
.DisplayGridlines = False
.DisplayHeadings = False
End With
Set F = ActiveSheet
F.DrawingObjects.Delete
[A1:C4].ClearContents
[C4].Select
q = InputBox("Entrez le diamètre ( de 100 à 450 ) de la cage" _
& vbLf & "et le nombre de billes ( de 3 à 50 )" _
& vbLf & "séparés par un astérisque.", _
" Roulement à billes", "400 * 10")
If q = "" Then Exit Sub
r = Split(q, "*")
If r(0) < 100 Or r(0) > 450 Then Exit Sub
'Nombre de billes
nb = r(1)
If nb < 3 Or nb > 50 Then Exit Sub
'Centre de la cage
cx1 = 350
cy1 = 240
'Rayon de la cage
gr = r(0) / 2
'Dessine la cage
With F.Shapes.AddShape _
(msoShapeOval, cx1 - gr, cy1 - gr, 2 * gr, 2 * gr)
.Fill.ForeColor.SchemeColor = 22
.Line.Weight = 2
End With
'Angle au centre sous-tendu par
'les tangentes à une des billes
Angle = WorksheetFunction.Radians(360 / nb)
a = Angle / 2
'Rayon des billes
rb = gr * Sin(a) / (1 + Sin(a))
'Dessine les billes
For i = 1 To nb
cx2 = cx1 + (gr - rb) * Cos(2 * i * a)
cy2 = cy1 - (gr - rb) * Sin(2 * i * a)
With F.Shapes.AddShape _
(msoShapeOval, cx2 - rb, cy2 - rb, 2 * rb, 2 * rb)
.Fill.ForeColor.SchemeColor = 1 + Int(56 * Rnd())
.Line.Weight = 1
End With
Next i
With F.DrawingObjects.Group
.Name = "billes"
End With
'Rayon de l'essieu
pr = gr * (1 - Sin(a)) / (1 + Sin(a))
'Dessine l'essieu
With F.Shapes.AddShape _
(msoShapeNoSymbol, cx1 - pr, cy1 - pr, 2 * pr, 2 * pr)
.Fill.ForeColor.SchemeColor = 1 + Int(56 * Rnd())
.Line.Weight = 1
.Name = "essieu"
End With
'Renseignements
[A1] = "Diamètre de la cage :"
[C1] = 2 * gr
[A2] = "Nombre de billes :"
[C2] = nb
[A3] = "Diamètre de l'essieu :"
[C3] = 2 * pr
[A4] = "Diamètre des billes :"
[C4] = 2 * rb
'Appelle la macro Tourne pour l'animation
'Pour annuler l'animation, mettre ' devant Tourne
Tourne
'Groupe le tout
F.DrawingObjects.Group
'garnote, août 2005
End Sub

Sub Tourne()
'Vous pouvez changer ces paramètres
rb = -3
re = 1
s = 20
'Animation
For i = 1 To 360
ActiveSheet.Shapes("billes").IncrementRotation rb
ActiveSheet.Shapes("essieu").IncrementRotation re
DoEvents
Sleep (s)
Next i
End Sub

LSteph

19/08/2005 à 21:09

Bonsoir Serge,

..............?....!§
...........mais en tout cas bravo!

lSteph

"garnote" a écrit dans le message de news:

Bonsoir tout le monde,

Je ne sais pas si l'animation est réaliste mais
les calculs sont corrects. Ça peut servir à
certains profs qui enseignent ce genre de chose.

Je commence à aimer ça, moé, Excel ;-)
A+

Serge

Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Sub Roulement_A_Billes()
'Application mathématique pour
'les techniques industrielles
'Copiez ces deux macros dans un module standard,
'activez une feuille vierge et appelez
'la macro Roulement_A_Billes.
On Error Resume Next
With Application
.DisplayFullScreen = True
.DisplayFormulaBar = False
End With
With ActiveWindow
.DisplayGridlines = False
.DisplayHeadings = False
End With
Set F = ActiveSheet
F.DrawingObjects.Delete
[A1:C4].ClearContents
[C4].Select
q = InputBox("Entrez le diamètre ( de 100 à 450 ) de la cage" _
& vbLf & "et le nombre de billes ( de 3 à 50 )" _
& vbLf & "séparés par un astérisque.", _
" Roulement à billes", "400 * 10")
If q = "" Then Exit Sub
r = Split(q, "*")
If r(0) < 100 Or r(0) > 450 Then Exit Sub
'Nombre de billes
nb = r(1)
If nb < 3 Or nb > 50 Then Exit Sub
'Centre de la cage
cx1 = 350
cy1 = 240
'Rayon de la cage
gr = r(0) / 2
'Dessine la cage
With F.Shapes.AddShape _
(msoShapeOval, cx1 - gr, cy1 - gr, 2 * gr, 2 * gr)
.Fill.ForeColor.SchemeColor = 22
.Line.Weight = 2
End With
'Angle au centre sous-tendu par
'les tangentes à une des billes
Angle = WorksheetFunction.Radians(360 / nb)
a = Angle / 2
'Rayon des billes
rb = gr * Sin(a) / (1 + Sin(a))
'Dessine les billes
For i = 1 To nb
cx2 = cx1 + (gr - rb) * Cos(2 * i * a)
cy2 = cy1 - (gr - rb) * Sin(2 * i * a)
With F.Shapes.AddShape _
(msoShapeOval, cx2 - rb, cy2 - rb, 2 * rb, 2 * rb)
.Fill.ForeColor.SchemeColor = 1 + Int(56 * Rnd())
.Line.Weight = 1
End With
Next i
With F.DrawingObjects.Group
.Name = "billes"
End With
'Rayon de l'essieu
pr = gr * (1 - Sin(a)) / (1 + Sin(a))
'Dessine l'essieu
With F.Shapes.AddShape _
(msoShapeNoSymbol, cx1 - pr, cy1 - pr, 2 * pr, 2 * pr)
.Fill.ForeColor.SchemeColor = 1 + Int(56 * Rnd())
.Line.Weight = 1
.Name = "essieu"
End With
'Renseignements
[A1] = "Diamètre de la cage :"
[C1] = 2 * gr
[A2] = "Nombre de billes :"
[C2] = nb
[A3] = "Diamètre de l'essieu :"
[C3] = 2 * pr
[A4] = "Diamètre des billes :"
[C4] = 2 * rb
'Appelle la macro Tourne pour l'animation
'Pour annuler l'animation, mettre ' devant Tourne
Tourne
'Groupe le tout
F.DrawingObjects.Group
'garnote, août 2005
End Sub

Sub Tourne()
'Vous pouvez changer ces paramètres
rb = -3
re = 1
s = 20
'Animation
For i = 1 To 360
ActiveSheet.Shapes("billes").IncrementRotation rb
ActiveSheet.Shapes("essieu").IncrementRotation re
DoEvents
Sleep (s)
Next i
End Sub

Bonsoir Serge,

..............?....!§
...........mais en tout cas bravo!

lSteph

"garnote" <rien@absent.com> a écrit dans le message de news:
uuuYWZNpFHA.3036@TK2MSFTNGP14.phx.gbl...

Bonsoir tout le monde,

Je ne sais pas si l'animation est réaliste mais
les calculs sont corrects. Ça peut servir à
certains profs qui enseignent ce genre de chose.

Je commence à aimer ça, moé, Excel ;-)
A+

Serge

Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Sub Roulement_A_Billes()
'Application mathématique pour
'les techniques industrielles
'Copiez ces deux macros dans un module standard,
'activez une feuille vierge et appelez
'la macro Roulement_A_Billes.
On Error Resume Next
With Application
.DisplayFullScreen = True
.DisplayFormulaBar = False
End With
With ActiveWindow
.DisplayGridlines = False
.DisplayHeadings = False
End With
Set F = ActiveSheet
F.DrawingObjects.Delete
[A1:C4].ClearContents
[C4].Select
q = InputBox("Entrez le diamètre ( de 100 à 450 ) de la cage" _
& vbLf & "et le nombre de billes ( de 3 à 50 )" _
& vbLf & "séparés par un astérisque.", _
" Roulement à billes", "400 * 10")
If q = "" Then Exit Sub
r = Split(q, "*")
If r(0) < 100 Or r(0) > 450 Then Exit Sub
'Nombre de billes
nb = r(1)
If nb < 3 Or nb > 50 Then Exit Sub
'Centre de la cage
cx1 = 350
cy1 = 240
'Rayon de la cage
gr = r(0) / 2
'Dessine la cage
With F.Shapes.AddShape _
(msoShapeOval, cx1 - gr, cy1 - gr, 2 * gr, 2 * gr)
.Fill.ForeColor.SchemeColor = 22
.Line.Weight = 2
End With
'Angle au centre sous-tendu par
'les tangentes à une des billes
Angle = WorksheetFunction.Radians(360 / nb)
a = Angle / 2
'Rayon des billes
rb = gr * Sin(a) / (1 + Sin(a))
'Dessine les billes
For i = 1 To nb
cx2 = cx1 + (gr - rb) * Cos(2 * i * a)
cy2 = cy1 - (gr - rb) * Sin(2 * i * a)
With F.Shapes.AddShape _
(msoShapeOval, cx2 - rb, cy2 - rb, 2 * rb, 2 * rb)
.Fill.ForeColor.SchemeColor = 1 + Int(56 * Rnd())
.Line.Weight = 1
End With
Next i
With F.DrawingObjects.Group
.Name = "billes"
End With
'Rayon de l'essieu
pr = gr * (1 - Sin(a)) / (1 + Sin(a))
'Dessine l'essieu
With F.Shapes.AddShape _
(msoShapeNoSymbol, cx1 - pr, cy1 - pr, 2 * pr, 2 * pr)
.Fill.ForeColor.SchemeColor = 1 + Int(56 * Rnd())
.Line.Weight = 1
.Name = "essieu"
End With
'Renseignements
[A1] = "Diamètre de la cage :"
[C1] = 2 * gr
[A2] = "Nombre de billes :"
[C2] = nb
[A3] = "Diamètre de l'essieu :"
[C3] = 2 * pr
[A4] = "Diamètre des billes :"
[C4] = 2 * rb
'Appelle la macro Tourne pour l'animation
'Pour annuler l'animation, mettre ' devant Tourne
Tourne
'Groupe le tout
F.DrawingObjects.Group
'garnote, août 2005
End Sub

Sub Tourne()
'Vous pouvez changer ces paramètres
rb = -3
re = 1
s = 20
'Animation
For i = 1 To 360
ActiveSheet.Shapes("billes").IncrementRotation rb
ActiveSheet.Shapes("essieu").IncrementRotation re
DoEvents
Sleep (s)
Next i
End Sub

Vous avez filtré cet utilisateur ! Consultez son message

Bonsoir Serge,

..............?....!§
...........mais en tout cas bravo!

lSteph

"garnote" a écrit dans le message de news:

Bonsoir tout le monde,

Je ne sais pas si l'animation est réaliste mais
les calculs sont corrects. Ça peut servir à
certains profs qui enseignent ce genre de chose.

Je commence à aimer ça, moé, Excel ;-)
A+

Serge

Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Sub Roulement_A_Billes()
'Application mathématique pour
'les techniques industrielles
'Copiez ces deux macros dans un module standard,
'activez une feuille vierge et appelez
'la macro Roulement_A_Billes.
On Error Resume Next
With Application
.DisplayFullScreen = True
.DisplayFormulaBar = False
End With
With ActiveWindow
.DisplayGridlines = False
.DisplayHeadings = False
End With
Set F = ActiveSheet
F.DrawingObjects.Delete
[A1:C4].ClearContents
[C4].Select
q = InputBox("Entrez le diamètre ( de 100 à 450 ) de la cage" _
& vbLf & "et le nombre de billes ( de 3 à 50 )" _
& vbLf & "séparés par un astérisque.", _
" Roulement à billes", "400 * 10")
If q = "" Then Exit Sub
r = Split(q, "*")
If r(0) < 100 Or r(0) > 450 Then Exit Sub
'Nombre de billes
nb = r(1)
If nb < 3 Or nb > 50 Then Exit Sub
'Centre de la cage
cx1 = 350
cy1 = 240
'Rayon de la cage
gr = r(0) / 2
'Dessine la cage
With F.Shapes.AddShape _
(msoShapeOval, cx1 - gr, cy1 - gr, 2 * gr, 2 * gr)
.Fill.ForeColor.SchemeColor = 22
.Line.Weight = 2
End With
'Angle au centre sous-tendu par
'les tangentes à une des billes
Angle = WorksheetFunction.Radians(360 / nb)
a = Angle / 2
'Rayon des billes
rb = gr * Sin(a) / (1 + Sin(a))
'Dessine les billes
For i = 1 To nb
cx2 = cx1 + (gr - rb) * Cos(2 * i * a)
cy2 = cy1 - (gr - rb) * Sin(2 * i * a)
With F.Shapes.AddShape _
(msoShapeOval, cx2 - rb, cy2 - rb, 2 * rb, 2 * rb)
.Fill.ForeColor.SchemeColor = 1 + Int(56 * Rnd())
.Line.Weight = 1
End With
Next i
With F.DrawingObjects.Group
.Name = "billes"
End With
'Rayon de l'essieu
pr = gr * (1 - Sin(a)) / (1 + Sin(a))
'Dessine l'essieu
With F.Shapes.AddShape _
(msoShapeNoSymbol, cx1 - pr, cy1 - pr, 2 * pr, 2 * pr)
.Fill.ForeColor.SchemeColor = 1 + Int(56 * Rnd())
.Line.Weight = 1
.Name = "essieu"
End With
'Renseignements
[A1] = "Diamètre de la cage :"
[C1] = 2 * gr
[A2] = "Nombre de billes :"
[C2] = nb
[A3] = "Diamètre de l'essieu :"
[C3] = 2 * pr
[A4] = "Diamètre des billes :"
[C4] = 2 * rb
'Appelle la macro Tourne pour l'animation
'Pour annuler l'animation, mettre ' devant Tourne
Tourne
'Groupe le tout
F.DrawingObjects.Group
'garnote, août 2005
End Sub

Sub Tourne()
'Vous pouvez changer ces paramètres
rb = -3
re = 1
s = 20
'Animation
For i = 1 To 360
ActiveSheet.Shapes("billes").IncrementRotation rb
ActiveSheet.Shapes("essieu").IncrementRotation re
DoEvents
Sleep (s)
Next i
End Sub

G. L

19/08/2005 à 21:42

Bonsoir Serge,

Je commence à aimer ça, moé, Excel ;-)

Et moé aussi, surtout lorsqu'il est possible de plus être " le nez dans
le guidon" et de pouvoir se détendre avec la remarquable exactitude qui est
tienne !

Pour info : il est possible de déplacer le moyeu lorsque l'ensemble est
en mouvement, ce qui ouvre éventuellement la porte à d'autres démonstrations
cinétiques (par exemple les roues dentées, sens de rotation, vitesse ....)

Mais à l'arrêt il n'est plus possible de déplacer le moyeu.

Voilà j'ai fait mumuse ;)

Bravo pour cet excellent travail !

Cordialement

Gérard

"garnote" a écrit dans le message de
news:

Bonsoir tout le monde,

Je ne sais pas si l'animation est réaliste mais
les calculs sont corrects. Ça peut servir à
certains profs qui enseignent ce genre de chose.

Je commence à aimer ça, moé, Excel ;-)
A+

Serge

Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Sub Roulement_A_Billes()
'Application mathématique pour
'les techniques industrielles
'Copiez ces deux macros dans un module standard,
'activez une feuille vierge et appelez
'la macro Roulement_A_Billes.
On Error Resume Next
With Application
.DisplayFullScreen = True
.DisplayFormulaBar = False
End With
With ActiveWindow
.DisplayGridlines = False
.DisplayHeadings = False
End With
Set F = ActiveSheet
F.DrawingObjects.Delete
[A1:C4].ClearContents
[C4].Select
q = InputBox("Entrez le diamètre ( de 100 à 450 ) de la cage" _
& vbLf & "et le nombre de billes ( de 3 à 50 )" _
& vbLf & "séparés par un astérisque.", _
" Roulement à billes", "400 * 10")
If q = "" Then Exit Sub
r = Split(q, "*")
If r(0) < 100 Or r(0) > 450 Then Exit Sub
'Nombre de billes
nb = r(1)
If nb < 3 Or nb > 50 Then Exit Sub
'Centre de la cage
cx1 = 350
cy1 = 240
'Rayon de la cage
gr = r(0) / 2
'Dessine la cage
With F.Shapes.AddShape _
(msoShapeOval, cx1 - gr, cy1 - gr, 2 * gr, 2 * gr)
.Fill.ForeColor.SchemeColor = 22
.Line.Weight = 2
End With
'Angle au centre sous-tendu par
'les tangentes à une des billes
Angle = WorksheetFunction.Radians(360 / nb)
a = Angle / 2
'Rayon des billes
rb = gr * Sin(a) / (1 + Sin(a))
'Dessine les billes
For i = 1 To nb
cx2 = cx1 + (gr - rb) * Cos(2 * i * a)
cy2 = cy1 - (gr - rb) * Sin(2 * i * a)
With F.Shapes.AddShape _
(msoShapeOval, cx2 - rb, cy2 - rb, 2 * rb, 2 * rb)
.Fill.ForeColor.SchemeColor = 1 + Int(56 * Rnd())
.Line.Weight = 1
End With
Next i
With F.DrawingObjects.Group
.Name = "billes"
End With
'Rayon de l'essieu
pr = gr * (1 - Sin(a)) / (1 + Sin(a))
'Dessine l'essieu
With F.Shapes.AddShape _
(msoShapeNoSymbol, cx1 - pr, cy1 - pr, 2 * pr, 2 * pr)
.Fill.ForeColor.SchemeColor = 1 + Int(56 * Rnd())
.Line.Weight = 1
.Name = "essieu"
End With
'Renseignements
[A1] = "Diamètre de la cage :"
[C1] = 2 * gr
[A2] = "Nombre de billes :"
[C2] = nb
[A3] = "Diamètre de l'essieu :"
[C3] = 2 * pr
[A4] = "Diamètre des billes :"
[C4] = 2 * rb
'Appelle la macro Tourne pour l'animation
'Pour annuler l'animation, mettre ' devant Tourne
Tourne
'Groupe le tout
F.DrawingObjects.Group
'garnote, août 2005
End Sub

Sub Tourne()
'Vous pouvez changer ces paramètres
rb = -3
re = 1
s = 20
'Animation
For i = 1 To 360
ActiveSheet.Shapes("billes").IncrementRotation rb
ActiveSheet.Shapes("essieu").IncrementRotation re
DoEvents
Sleep (s)
Next i
End Sub

Bonsoir Serge,

Je commence à aimer ça, moé, Excel ;-)

Et moé aussi, surtout lorsqu'il est possible de plus être " le nez dans
le guidon" et de pouvoir se détendre avec la remarquable exactitude qui est
tienne !

Pour info : il est possible de déplacer le moyeu lorsque l'ensemble est
en mouvement, ce qui ouvre éventuellement la porte à d'autres démonstrations
cinétiques (par exemple les roues dentées, sens de rotation, vitesse ....)

Mais à l'arrêt il n'est plus possible de déplacer le moyeu.

Voilà j'ai fait mumuse ;)

Bravo pour cet excellent travail !

Cordialement

Gérard

"garnote" <rien@absent.com> a écrit dans le message de
news:uuuYWZNpFHA.3036@TK2MSFTNGP14.phx.gbl...

Bonsoir tout le monde,

Je ne sais pas si l'animation est réaliste mais
les calculs sont corrects. Ça peut servir à
certains profs qui enseignent ce genre de chose.

Je commence à aimer ça, moé, Excel ;-)
A+

Serge

Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Sub Roulement_A_Billes()
'Application mathématique pour
'les techniques industrielles
'Copiez ces deux macros dans un module standard,
'activez une feuille vierge et appelez
'la macro Roulement_A_Billes.
On Error Resume Next
With Application
.DisplayFullScreen = True
.DisplayFormulaBar = False
End With
With ActiveWindow
.DisplayGridlines = False
.DisplayHeadings = False
End With
Set F = ActiveSheet
F.DrawingObjects.Delete
[A1:C4].ClearContents
[C4].Select
q = InputBox("Entrez le diamètre ( de 100 à 450 ) de la cage" _
& vbLf & "et le nombre de billes ( de 3 à 50 )" _
& vbLf & "séparés par un astérisque.", _
" Roulement à billes", "400 * 10")
If q = "" Then Exit Sub
r = Split(q, "*")
If r(0) < 100 Or r(0) > 450 Then Exit Sub
'Nombre de billes
nb = r(1)
If nb < 3 Or nb > 50 Then Exit Sub
'Centre de la cage
cx1 = 350
cy1 = 240
'Rayon de la cage
gr = r(0) / 2
'Dessine la cage
With F.Shapes.AddShape _
(msoShapeOval, cx1 - gr, cy1 - gr, 2 * gr, 2 * gr)
.Fill.ForeColor.SchemeColor = 22
.Line.Weight = 2
End With
'Angle au centre sous-tendu par
'les tangentes à une des billes
Angle = WorksheetFunction.Radians(360 / nb)
a = Angle / 2
'Rayon des billes
rb = gr * Sin(a) / (1 + Sin(a))
'Dessine les billes
For i = 1 To nb
cx2 = cx1 + (gr - rb) * Cos(2 * i * a)
cy2 = cy1 - (gr - rb) * Sin(2 * i * a)
With F.Shapes.AddShape _
(msoShapeOval, cx2 - rb, cy2 - rb, 2 * rb, 2 * rb)
.Fill.ForeColor.SchemeColor = 1 + Int(56 * Rnd())
.Line.Weight = 1
End With
Next i
With F.DrawingObjects.Group
.Name = "billes"
End With
'Rayon de l'essieu
pr = gr * (1 - Sin(a)) / (1 + Sin(a))
'Dessine l'essieu
With F.Shapes.AddShape _
(msoShapeNoSymbol, cx1 - pr, cy1 - pr, 2 * pr, 2 * pr)
.Fill.ForeColor.SchemeColor = 1 + Int(56 * Rnd())
.Line.Weight = 1
.Name = "essieu"
End With
'Renseignements
[A1] = "Diamètre de la cage :"
[C1] = 2 * gr
[A2] = "Nombre de billes :"
[C2] = nb
[A3] = "Diamètre de l'essieu :"
[C3] = 2 * pr
[A4] = "Diamètre des billes :"
[C4] = 2 * rb
'Appelle la macro Tourne pour l'animation
'Pour annuler l'animation, mettre ' devant Tourne
Tourne
'Groupe le tout
F.DrawingObjects.Group
'garnote, août 2005
End Sub

Sub Tourne()
'Vous pouvez changer ces paramètres
rb = -3
re = 1
s = 20
'Animation
For i = 1 To 360
ActiveSheet.Shapes("billes").IncrementRotation rb
ActiveSheet.Shapes("essieu").IncrementRotation re
DoEvents
Sleep (s)
Next i
End Sub

Vous avez filtré cet utilisateur ! Consultez son message

Bonsoir Serge,

Je commence à aimer ça, moé, Excel ;-)

Et moé aussi, surtout lorsqu'il est possible de plus être " le nez dans
le guidon" et de pouvoir se détendre avec la remarquable exactitude qui est
tienne !

Pour info : il est possible de déplacer le moyeu lorsque l'ensemble est
en mouvement, ce qui ouvre éventuellement la porte à d'autres démonstrations
cinétiques (par exemple les roues dentées, sens de rotation, vitesse ....)

Mais à l'arrêt il n'est plus possible de déplacer le moyeu.

Voilà j'ai fait mumuse ;)

Bravo pour cet excellent travail !

Cordialement

Gérard

"garnote" a écrit dans le message de
news:

Bonsoir tout le monde,

Je ne sais pas si l'animation est réaliste mais
les calculs sont corrects. Ça peut servir à
certains profs qui enseignent ce genre de chose.

Je commence à aimer ça, moé, Excel ;-)
A+

Serge

Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Sub Roulement_A_Billes()
'Application mathématique pour
'les techniques industrielles
'Copiez ces deux macros dans un module standard,
'activez une feuille vierge et appelez
'la macro Roulement_A_Billes.
On Error Resume Next
With Application
.DisplayFullScreen = True
.DisplayFormulaBar = False
End With
With ActiveWindow
.DisplayGridlines = False
.DisplayHeadings = False
End With
Set F = ActiveSheet
F.DrawingObjects.Delete
[A1:C4].ClearContents
[C4].Select
q = InputBox("Entrez le diamètre ( de 100 à 450 ) de la cage" _
& vbLf & "et le nombre de billes ( de 3 à 50 )" _
& vbLf & "séparés par un astérisque.", _
" Roulement à billes", "400 * 10")
If q = "" Then Exit Sub
r = Split(q, "*")
If r(0) < 100 Or r(0) > 450 Then Exit Sub
'Nombre de billes
nb = r(1)
If nb < 3 Or nb > 50 Then Exit Sub
'Centre de la cage
cx1 = 350
cy1 = 240
'Rayon de la cage
gr = r(0) / 2
'Dessine la cage
With F.Shapes.AddShape _
(msoShapeOval, cx1 - gr, cy1 - gr, 2 * gr, 2 * gr)
.Fill.ForeColor.SchemeColor = 22
.Line.Weight = 2
End With
'Angle au centre sous-tendu par
'les tangentes à une des billes
Angle = WorksheetFunction.Radians(360 / nb)
a = Angle / 2
'Rayon des billes
rb = gr * Sin(a) / (1 + Sin(a))
'Dessine les billes
For i = 1 To nb
cx2 = cx1 + (gr - rb) * Cos(2 * i * a)
cy2 = cy1 - (gr - rb) * Sin(2 * i * a)
With F.Shapes.AddShape _
(msoShapeOval, cx2 - rb, cy2 - rb, 2 * rb, 2 * rb)
.Fill.ForeColor.SchemeColor = 1 + Int(56 * Rnd())
.Line.Weight = 1
End With
Next i
With F.DrawingObjects.Group
.Name = "billes"
End With
'Rayon de l'essieu
pr = gr * (1 - Sin(a)) / (1 + Sin(a))
'Dessine l'essieu
With F.Shapes.AddShape _
(msoShapeNoSymbol, cx1 - pr, cy1 - pr, 2 * pr, 2 * pr)
.Fill.ForeColor.SchemeColor = 1 + Int(56 * Rnd())
.Line.Weight = 1
.Name = "essieu"
End With
'Renseignements
[A1] = "Diamètre de la cage :"
[C1] = 2 * gr
[A2] = "Nombre de billes :"
[C2] = nb
[A3] = "Diamètre de l'essieu :"
[C3] = 2 * pr
[A4] = "Diamètre des billes :"
[C4] = 2 * rb
'Appelle la macro Tourne pour l'animation
'Pour annuler l'animation, mettre ' devant Tourne
Tourne
'Groupe le tout
F.DrawingObjects.Group
'garnote, août 2005
End Sub

Sub Tourne()
'Vous pouvez changer ces paramètres
rb = -3
re = 1
s = 20
'Animation
For i = 1 To 360
ActiveSheet.Shapes("billes").IncrementRotation rb
ActiveSheet.Shapes("essieu").IncrementRotation re
DoEvents
Sleep (s)
Next i
End Sub

gamma60

20/08/2005 à 12:23

bonjour
dans sub tourne(), je bute sur "sleep (s)"
comme je ne connais pas ....je ne vois pas quoi faire pour contourner le
probléme
un coup de main ???
je suis frustrée
merci

--
gamma60

In news:,
G. <sugere~KillPub~@online.fr> typed:

Bonsoir Serge,

Je commence à aimer ça, moé, Excel ;-)

Et moé aussi, surtout lorsqu'il est possible de plus être " le nez
dans le guidon" et de pouvoir se détendre avec la remarquable
exactitude qui est tienne !

Pour info : il est possible de déplacer le moyeu lorsque l'ensemble
est en mouvement, ce qui ouvre éventuellement la porte à d'autres
démonstrations cinétiques (par exemple les roues dentées, sens de
rotation, vitesse ....)

Mais à l'arrêt il n'est plus possible de déplacer le moyeu.

Voilà j'ai fait mumuse ;)

Bravo pour cet excellent travail !

Cordialement

Gérard

"garnote" a écrit dans le message de
news:
Bonsoir tout le monde,

Je ne sais pas si l'animation est réaliste mais
les calculs sont corrects. Ça peut servir à
certains profs qui enseignent ce genre de chose.

Je commence à aimer ça, moé, Excel ;-)
A+

Serge

Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Sub Roulement_A_Billes()
'Application mathématique pour
'les techniques industrielles
'Copiez ces deux macros dans un module standard,
'activez une feuille vierge et appelez
'la macro Roulement_A_Billes.
On Error Resume Next
With Application
.DisplayFullScreen = True
.DisplayFormulaBar = False
End With
With ActiveWindow
.DisplayGridlines = False
.DisplayHeadings = False
End With
Set F = ActiveSheet
F.DrawingObjects.Delete
[A1:C4].ClearContents
[C4].Select
q = InputBox("Entrez le diamètre ( de 100 à 450 ) de la cage" _
& vbLf & "et le nombre de billes ( de 3 à 50 )" _
& vbLf & "séparés par un astérisque.", _
" Roulement à billes", "400 * 10")
If q = "" Then Exit Sub
r = Split(q, "*")
If r(0) < 100 Or r(0) > 450 Then Exit Sub
'Nombre de billes
nb = r(1)
If nb < 3 Or nb > 50 Then Exit Sub
'Centre de la cage
cx1 = 350
cy1 = 240
'Rayon de la cage
gr = r(0) / 2
'Dessine la cage
With F.Shapes.AddShape _
(msoShapeOval, cx1 - gr, cy1 - gr, 2 * gr, 2 * gr)
.Fill.ForeColor.SchemeColor = 22
.Line.Weight = 2
End With
'Angle au centre sous-tendu par
'les tangentes à une des billes
Angle = WorksheetFunction.Radians(360 / nb)
a = Angle / 2
'Rayon des billes
rb = gr * Sin(a) / (1 + Sin(a))
'Dessine les billes
For i = 1 To nb
cx2 = cx1 + (gr - rb) * Cos(2 * i * a)
cy2 = cy1 - (gr - rb) * Sin(2 * i * a)
With F.Shapes.AddShape _
(msoShapeOval, cx2 - rb, cy2 - rb, 2 * rb, 2 * rb)
.Fill.ForeColor.SchemeColor = 1 + Int(56 * Rnd())
.Line.Weight = 1
End With
Next i
With F.DrawingObjects.Group
.Name = "billes"
End With
'Rayon de l'essieu
pr = gr * (1 - Sin(a)) / (1 + Sin(a))
'Dessine l'essieu
With F.Shapes.AddShape _
(msoShapeNoSymbol, cx1 - pr, cy1 - pr, 2 * pr, 2 * pr)
.Fill.ForeColor.SchemeColor = 1 + Int(56 * Rnd())
.Line.Weight = 1
.Name = "essieu"
End With
'Renseignements
[A1] = "Diamètre de la cage :"
[C1] = 2 * gr
[A2] = "Nombre de billes :"
[C2] = nb
[A3] = "Diamètre de l'essieu :"
[C3] = 2 * pr
[A4] = "Diamètre des billes :"
[C4] = 2 * rb
'Appelle la macro Tourne pour l'animation
'Pour annuler l'animation, mettre ' devant Tourne
Tourne
'Groupe le tout
F.DrawingObjects.Group
'garnote, août 2005
End Sub

Sub Tourne()
'Vous pouvez changer ces paramètres
rb = -3
re = 1
s = 20
'Animation
For i = 1 To 360
ActiveSheet.Shapes("billes").IncrementRotation rb
ActiveSheet.Shapes("essieu").IncrementRotation re
DoEvents
Sleep (s)
Next i
End Sub

bonjour
dans sub tourne(), je bute sur "sleep (s)"
comme je ne connais pas ....je ne vois pas quoi faire pour contourner le
probléme
un coup de main ???
je suis frustrée
merci

--
gamma60

In news:eAs5sYPpFHA.3756@TK2MSFTNGP09.phx.gbl,
G. L@rumeur <sugere~KillPub~@online.fr> typed:

Bonsoir Serge,

Je commence à aimer ça, moé, Excel ;-)

Et moé aussi, surtout lorsqu'il est possible de plus être " le nez
dans le guidon" et de pouvoir se détendre avec la remarquable
exactitude qui est tienne !

Pour info : il est possible de déplacer le moyeu lorsque l'ensemble
est en mouvement, ce qui ouvre éventuellement la porte à d'autres
démonstrations cinétiques (par exemple les roues dentées, sens de
rotation, vitesse ....)

Mais à l'arrêt il n'est plus possible de déplacer le moyeu.

Voilà j'ai fait mumuse ;)

Bravo pour cet excellent travail !

Cordialement

Gérard

"garnote" <rien@absent.com> a écrit dans le message de
news:uuuYWZNpFHA.3036@TK2MSFTNGP14.phx.gbl...

Bonsoir tout le monde,

Je ne sais pas si l'animation est réaliste mais
les calculs sont corrects. Ça peut servir à
certains profs qui enseignent ce genre de chose.

Je commence à aimer ça, moé, Excel ;-)
A+

Serge

Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Sub Roulement_A_Billes()
'Application mathématique pour
'les techniques industrielles
'Copiez ces deux macros dans un module standard,
'activez une feuille vierge et appelez
'la macro Roulement_A_Billes.
On Error Resume Next
With Application
.DisplayFullScreen = True
.DisplayFormulaBar = False
End With
With ActiveWindow
.DisplayGridlines = False
.DisplayHeadings = False
End With
Set F = ActiveSheet
F.DrawingObjects.Delete
[A1:C4].ClearContents
[C4].Select
q = InputBox("Entrez le diamètre ( de 100 à 450 ) de la cage" _
& vbLf & "et le nombre de billes ( de 3 à 50 )" _
& vbLf & "séparés par un astérisque.", _
" Roulement à billes", "400 * 10")
If q = "" Then Exit Sub
r = Split(q, "*")
If r(0) < 100 Or r(0) > 450 Then Exit Sub
'Nombre de billes
nb = r(1)
If nb < 3 Or nb > 50 Then Exit Sub
'Centre de la cage
cx1 = 350
cy1 = 240
'Rayon de la cage
gr = r(0) / 2
'Dessine la cage
With F.Shapes.AddShape _
(msoShapeOval, cx1 - gr, cy1 - gr, 2 * gr, 2 * gr)
.Fill.ForeColor.SchemeColor = 22
.Line.Weight = 2
End With
'Angle au centre sous-tendu par
'les tangentes à une des billes
Angle = WorksheetFunction.Radians(360 / nb)
a = Angle / 2
'Rayon des billes
rb = gr * Sin(a) / (1 + Sin(a))
'Dessine les billes
For i = 1 To nb
cx2 = cx1 + (gr - rb) * Cos(2 * i * a)
cy2 = cy1 - (gr - rb) * Sin(2 * i * a)
With F.Shapes.AddShape _
(msoShapeOval, cx2 - rb, cy2 - rb, 2 * rb, 2 * rb)
.Fill.ForeColor.SchemeColor = 1 + Int(56 * Rnd())
.Line.Weight = 1
End With
Next i
With F.DrawingObjects.Group
.Name = "billes"
End With
'Rayon de l'essieu
pr = gr * (1 - Sin(a)) / (1 + Sin(a))
'Dessine l'essieu
With F.Shapes.AddShape _
(msoShapeNoSymbol, cx1 - pr, cy1 - pr, 2 * pr, 2 * pr)
.Fill.ForeColor.SchemeColor = 1 + Int(56 * Rnd())
.Line.Weight = 1
.Name = "essieu"
End With
'Renseignements
[A1] = "Diamètre de la cage :"
[C1] = 2 * gr
[A2] = "Nombre de billes :"
[C2] = nb
[A3] = "Diamètre de l'essieu :"
[C3] = 2 * pr
[A4] = "Diamètre des billes :"
[C4] = 2 * rb
'Appelle la macro Tourne pour l'animation
'Pour annuler l'animation, mettre ' devant Tourne
Tourne
'Groupe le tout
F.DrawingObjects.Group
'garnote, août 2005
End Sub

Sub Tourne()
'Vous pouvez changer ces paramètres
rb = -3
re = 1
s = 20
'Animation
For i = 1 To 360
ActiveSheet.Shapes("billes").IncrementRotation rb
ActiveSheet.Shapes("essieu").IncrementRotation re
DoEvents
Sleep (s)
Next i
End Sub

Vous avez filtré cet utilisateur ! Consultez son message

bonjour
dans sub tourne(), je bute sur "sleep (s)"
comme je ne connais pas ....je ne vois pas quoi faire pour contourner le
probléme
un coup de main ???
je suis frustrée
merci

--
gamma60

In news:,
G. <sugere~KillPub~@online.fr> typed:

Bonsoir Serge,

Je commence à aimer ça, moé, Excel ;-)

Et moé aussi, surtout lorsqu'il est possible de plus être " le nez
dans le guidon" et de pouvoir se détendre avec la remarquable
exactitude qui est tienne !

Pour info : il est possible de déplacer le moyeu lorsque l'ensemble
est en mouvement, ce qui ouvre éventuellement la porte à d'autres
démonstrations cinétiques (par exemple les roues dentées, sens de
rotation, vitesse ....)

Mais à l'arrêt il n'est plus possible de déplacer le moyeu.

Voilà j'ai fait mumuse ;)

Bravo pour cet excellent travail !

Cordialement

Gérard

"garnote" a écrit dans le message de
news:
Bonsoir tout le monde,

Je ne sais pas si l'animation est réaliste mais
les calculs sont corrects. Ça peut servir à
certains profs qui enseignent ce genre de chose.

Je commence à aimer ça, moé, Excel ;-)
A+

Serge

Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Sub Roulement_A_Billes()
'Application mathématique pour
'les techniques industrielles
'Copiez ces deux macros dans un module standard,
'activez une feuille vierge et appelez
'la macro Roulement_A_Billes.
On Error Resume Next
With Application
.DisplayFullScreen = True
.DisplayFormulaBar = False
End With
With ActiveWindow
.DisplayGridlines = False
.DisplayHeadings = False
End With
Set F = ActiveSheet
F.DrawingObjects.Delete
[A1:C4].ClearContents
[C4].Select
q = InputBox("Entrez le diamètre ( de 100 à 450 ) de la cage" _
& vbLf & "et le nombre de billes ( de 3 à 50 )" _
& vbLf & "séparés par un astérisque.", _
" Roulement à billes", "400 * 10")
If q = "" Then Exit Sub
r = Split(q, "*")
If r(0) < 100 Or r(0) > 450 Then Exit Sub
'Nombre de billes
nb = r(1)
If nb < 3 Or nb > 50 Then Exit Sub
'Centre de la cage
cx1 = 350
cy1 = 240
'Rayon de la cage
gr = r(0) / 2
'Dessine la cage
With F.Shapes.AddShape _
(msoShapeOval, cx1 - gr, cy1 - gr, 2 * gr, 2 * gr)
.Fill.ForeColor.SchemeColor = 22
.Line.Weight = 2
End With
'Angle au centre sous-tendu par
'les tangentes à une des billes
Angle = WorksheetFunction.Radians(360 / nb)
a = Angle / 2
'Rayon des billes
rb = gr * Sin(a) / (1 + Sin(a))
'Dessine les billes
For i = 1 To nb
cx2 = cx1 + (gr - rb) * Cos(2 * i * a)
cy2 = cy1 - (gr - rb) * Sin(2 * i * a)
With F.Shapes.AddShape _
(msoShapeOval, cx2 - rb, cy2 - rb, 2 * rb, 2 * rb)
.Fill.ForeColor.SchemeColor = 1 + Int(56 * Rnd())
.Line.Weight = 1
End With
Next i
With F.DrawingObjects.Group
.Name = "billes"
End With
'Rayon de l'essieu
pr = gr * (1 - Sin(a)) / (1 + Sin(a))
'Dessine l'essieu
With F.Shapes.AddShape _
(msoShapeNoSymbol, cx1 - pr, cy1 - pr, 2 * pr, 2 * pr)
.Fill.ForeColor.SchemeColor = 1 + Int(56 * Rnd())
.Line.Weight = 1
.Name = "essieu"
End With
'Renseignements
[A1] = "Diamètre de la cage :"
[C1] = 2 * gr
[A2] = "Nombre de billes :"
[C2] = nb
[A3] = "Diamètre de l'essieu :"
[C3] = 2 * pr
[A4] = "Diamètre des billes :"
[C4] = 2 * rb
'Appelle la macro Tourne pour l'animation
'Pour annuler l'animation, mettre ' devant Tourne
Tourne
'Groupe le tout
F.DrawingObjects.Group
'garnote, août 2005
End Sub

Sub Tourne()
'Vous pouvez changer ces paramètres
rb = -3
re = 1
s = 20
'Animation
For i = 1 To 360
ActiveSheet.Shapes("billes").IncrementRotation rb
ActiveSheet.Shapes("essieu").IncrementRotation re
DoEvents
Sleep (s)
Next i
End Sub

Modeste

20/08/2005 à 13:53

Bonsour® gamma60
au début de ton module il faut inserer la déclaration :
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

cette routine qui est une API qui fait partie du noyau windows, arréte la
procedure en cours pour la durée passée en millisecondes
ex : Sleep 1000 ' fait une pause de 1 seconde
cette routine sert à ralentir la boucle
elle peut etre omise mais selon la rapidité du processeur il est alors
possible que l'animation ne soit pas visible

à considerer également que les API windows créent des soucis d'utilisation
des macros sous Excel MAC
dans ce cas, elle peut alors etre remplacée par :
Application.Wait (Now + (TimeValue("0:00:01") / 10)) ' ici équivaut à 1/10e
seconde

ou par toute autre traitement inutile mais prenant "un certain temps"
ex : for rien =1 to 100000: application.statusbar=rien : next
;o)))
@+
wrote:

bonjour
dans sub tourne(), je bute sur "sleep (s)"
comme je ne connais pas ....je ne vois pas quoi faire pour contourner
le probléme
un coup de main ???
je suis frustrée
merci

In news:,
G. <sugere~KillPub~@online.fr> typed:
Bonsoir Serge,

Je commence à aimer ça, moé, Excel ;-)

Et moé aussi, surtout lorsqu'il est possible de plus être " le nez
dans le guidon" et de pouvoir se détendre avec la remarquable
exactitude qui est tienne !

Pour info : il est possible de déplacer le moyeu lorsque l'ensemble
est en mouvement, ce qui ouvre éventuellement la porte à d'autres
démonstrations cinétiques (par exemple les roues dentées, sens de
rotation, vitesse ....)

Mais à l'arrêt il n'est plus possible de déplacer le moyeu.

Voilà j'ai fait mumuse ;)

Bravo pour cet excellent travail !

Cordialement

Gérard

"garnote" a écrit dans le message de
news:
Bonsoir tout le monde,

Je ne sais pas si l'animation est réaliste mais
les calculs sont corrects. Ça peut servir à
certains profs qui enseignent ce genre de chose.

Je commence à aimer ça, moé, Excel ;-)
A+

Serge

Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Sub Roulement_A_Billes()
'Application mathématique pour
'les techniques industrielles
'Copiez ces deux macros dans un module standard,
'activez une feuille vierge et appelez
'la macro Roulement_A_Billes.
On Error Resume Next
With Application
.DisplayFullScreen = True
.DisplayFormulaBar = False
End With
With ActiveWindow
.DisplayGridlines = False
.DisplayHeadings = False
End With
Set F = ActiveSheet
F.DrawingObjects.Delete
[A1:C4].ClearContents
[C4].Select
q = InputBox("Entrez le diamètre ( de 100 à 450 ) de la cage" _
& vbLf & "et le nombre de billes ( de 3 à 50 )" _
& vbLf & "séparés par un astérisque.", _
" Roulement à billes", "400 * 10")
If q = "" Then Exit Sub
r = Split(q, "*")
If r(0) < 100 Or r(0) > 450 Then Exit Sub
'Nombre de billes
nb = r(1)
If nb < 3 Or nb > 50 Then Exit Sub
'Centre de la cage
cx1 = 350
cy1 = 240
'Rayon de la cage
gr = r(0) / 2
'Dessine la cage
With F.Shapes.AddShape _
(msoShapeOval, cx1 - gr, cy1 - gr, 2 * gr, 2 * gr)
.Fill.ForeColor.SchemeColor = 22
.Line.Weight = 2
End With
'Angle au centre sous-tendu par
'les tangentes à une des billes
Angle = WorksheetFunction.Radians(360 / nb)
a = Angle / 2
'Rayon des billes
rb = gr * Sin(a) / (1 + Sin(a))
'Dessine les billes
For i = 1 To nb
cx2 = cx1 + (gr - rb) * Cos(2 * i * a)
cy2 = cy1 - (gr - rb) * Sin(2 * i * a)
With F.Shapes.AddShape _
(msoShapeOval, cx2 - rb, cy2 - rb, 2 * rb, 2 * rb)
.Fill.ForeColor.SchemeColor = 1 + Int(56 * Rnd())
.Line.Weight = 1
End With
Next i
With F.DrawingObjects.Group
.Name = "billes"
End With
'Rayon de l'essieu
pr = gr * (1 - Sin(a)) / (1 + Sin(a))
'Dessine l'essieu
With F.Shapes.AddShape _
(msoShapeNoSymbol, cx1 - pr, cy1 - pr, 2 * pr, 2 * pr)
.Fill.ForeColor.SchemeColor = 1 + Int(56 * Rnd())
.Line.Weight = 1
.Name = "essieu"
End With
'Renseignements
[A1] = "Diamètre de la cage :"
[C1] = 2 * gr
[A2] = "Nombre de billes :"
[C2] = nb
[A3] = "Diamètre de l'essieu :"
[C3] = 2 * pr
[A4] = "Diamètre des billes :"
[C4] = 2 * rb
'Appelle la macro Tourne pour l'animation
'Pour annuler l'animation, mettre ' devant Tourne
Tourne
'Groupe le tout
F.DrawingObjects.Group
'garnote, août 2005
End Sub

Sub Tourne()
'Vous pouvez changer ces paramètres
rb = -3
re = 1
s = 20
'Animation
For i = 1 To 360
ActiveSheet.Shapes("billes").IncrementRotation rb
ActiveSheet.Shapes("essieu").IncrementRotation re
DoEvents
Sleep (s)
Next i
End Sub

--
n'oubliez pas les FAQ :
http://www.excelabo.net http://dj.joss.free.fr/faq.htm
http://www.faqoe.com http://faqword.free.fr
--
Feed Back
http://viadresse.com/?94912042

Bonsour® gamma60
au début de ton module il faut inserer la déclaration :
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

cette routine qui est une API qui fait partie du noyau windows, arréte la
procedure en cours pour la durée passée en millisecondes
ex : Sleep 1000 ' fait une pause de 1 seconde
cette routine sert à ralentir la boucle
elle peut etre omise mais selon la rapidité du processeur il est alors
possible que l'animation ne soit pas visible

à considerer également que les API windows créent des soucis d'utilisation
des macros sous Excel MAC
dans ce cas, elle peut alors etre remplacée par :
Application.Wait (Now + (TimeValue("0:00:01") / 10)) ' ici équivaut à 1/10e
seconde

ou par toute autre traitement inutile mais prenant "un certain temps"
ex : for rien =1 to 100000: application.statusbar=rien : next
;o)))
@+
wrote:

bonjour
dans sub tourne(), je bute sur "sleep (s)"
comme je ne connais pas ....je ne vois pas quoi faire pour contourner
le probléme
un coup de main ???
je suis frustrée
merci

In news:eAs5sYPpFHA.3756@TK2MSFTNGP09.phx.gbl,
G. L@rumeur <sugere~KillPub~@online.fr> typed:

Bonsoir Serge,

Je commence à aimer ça, moé, Excel ;-)

Et moé aussi, surtout lorsqu'il est possible de plus être " le nez
dans le guidon" et de pouvoir se détendre avec la remarquable
exactitude qui est tienne !

Pour info : il est possible de déplacer le moyeu lorsque l'ensemble
est en mouvement, ce qui ouvre éventuellement la porte à d'autres
démonstrations cinétiques (par exemple les roues dentées, sens de
rotation, vitesse ....)

Mais à l'arrêt il n'est plus possible de déplacer le moyeu.

Voilà j'ai fait mumuse ;)

Bravo pour cet excellent travail !

Cordialement

Gérard

"garnote" <rien@absent.com> a écrit dans le message de
news:uuuYWZNpFHA.3036@TK2MSFTNGP14.phx.gbl...

Bonsoir tout le monde,

Je ne sais pas si l'animation est réaliste mais
les calculs sont corrects. Ça peut servir à
certains profs qui enseignent ce genre de chose.

Je commence à aimer ça, moé, Excel ;-)
A+

Serge

Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Sub Roulement_A_Billes()
'Application mathématique pour
'les techniques industrielles
'Copiez ces deux macros dans un module standard,
'activez une feuille vierge et appelez
'la macro Roulement_A_Billes.
On Error Resume Next
With Application
.DisplayFullScreen = True
.DisplayFormulaBar = False
End With
With ActiveWindow
.DisplayGridlines = False
.DisplayHeadings = False
End With
Set F = ActiveSheet
F.DrawingObjects.Delete
[A1:C4].ClearContents
[C4].Select
q = InputBox("Entrez le diamètre ( de 100 à 450 ) de la cage" _
& vbLf & "et le nombre de billes ( de 3 à 50 )" _
& vbLf & "séparés par un astérisque.", _
" Roulement à billes", "400 * 10")
If q = "" Then Exit Sub
r = Split(q, "*")
If r(0) < 100 Or r(0) > 450 Then Exit Sub
'Nombre de billes
nb = r(1)
If nb < 3 Or nb > 50 Then Exit Sub
'Centre de la cage
cx1 = 350
cy1 = 240
'Rayon de la cage
gr = r(0) / 2
'Dessine la cage
With F.Shapes.AddShape _
(msoShapeOval, cx1 - gr, cy1 - gr, 2 * gr, 2 * gr)
.Fill.ForeColor.SchemeColor = 22
.Line.Weight = 2
End With
'Angle au centre sous-tendu par
'les tangentes à une des billes
Angle = WorksheetFunction.Radians(360 / nb)
a = Angle / 2
'Rayon des billes
rb = gr * Sin(a) / (1 + Sin(a))
'Dessine les billes
For i = 1 To nb
cx2 = cx1 + (gr - rb) * Cos(2 * i * a)
cy2 = cy1 - (gr - rb) * Sin(2 * i * a)
With F.Shapes.AddShape _
(msoShapeOval, cx2 - rb, cy2 - rb, 2 * rb, 2 * rb)
.Fill.ForeColor.SchemeColor = 1 + Int(56 * Rnd())
.Line.Weight = 1
End With
Next i
With F.DrawingObjects.Group
.Name = "billes"
End With
'Rayon de l'essieu
pr = gr * (1 - Sin(a)) / (1 + Sin(a))
'Dessine l'essieu
With F.Shapes.AddShape _
(msoShapeNoSymbol, cx1 - pr, cy1 - pr, 2 * pr, 2 * pr)
.Fill.ForeColor.SchemeColor = 1 + Int(56 * Rnd())
.Line.Weight = 1
.Name = "essieu"
End With
'Renseignements
[A1] = "Diamètre de la cage :"
[C1] = 2 * gr
[A2] = "Nombre de billes :"
[C2] = nb
[A3] = "Diamètre de l'essieu :"
[C3] = 2 * pr
[A4] = "Diamètre des billes :"
[C4] = 2 * rb
'Appelle la macro Tourne pour l'animation
'Pour annuler l'animation, mettre ' devant Tourne
Tourne
'Groupe le tout
F.DrawingObjects.Group
'garnote, août 2005
End Sub

Sub Tourne()
'Vous pouvez changer ces paramètres
rb = -3
re = 1
s = 20
'Animation
For i = 1 To 360
ActiveSheet.Shapes("billes").IncrementRotation rb
ActiveSheet.Shapes("essieu").IncrementRotation re
DoEvents
Sleep (s)
Next i
End Sub

--
n'oubliez pas les FAQ :
http://www.excelabo.net http://dj.joss.free.fr/faq.htm
http://www.faqoe.com http://faqword.free.fr
--
Feed Back
http://viadresse.com/?94912042

Vous avez filtré cet utilisateur ! Consultez son message

Bonsour® gamma60
au début de ton module il faut inserer la déclaration :
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

cette routine qui est une API qui fait partie du noyau windows, arréte la
procedure en cours pour la durée passée en millisecondes
ex : Sleep 1000 ' fait une pause de 1 seconde
cette routine sert à ralentir la boucle
elle peut etre omise mais selon la rapidité du processeur il est alors
possible que l'animation ne soit pas visible

à considerer également que les API windows créent des soucis d'utilisation
des macros sous Excel MAC
dans ce cas, elle peut alors etre remplacée par :
Application.Wait (Now + (TimeValue("0:00:01") / 10)) ' ici équivaut à 1/10e
seconde

ou par toute autre traitement inutile mais prenant "un certain temps"
ex : for rien =1 to 100000: application.statusbar=rien : next
;o)))
@+
wrote:

bonjour
dans sub tourne(), je bute sur "sleep (s)"
comme je ne connais pas ....je ne vois pas quoi faire pour contourner
le probléme
un coup de main ???
je suis frustrée
merci

In news:,
G. <sugere~KillPub~@online.fr> typed:
Bonsoir Serge,

Je commence à aimer ça, moé, Excel ;-)

Et moé aussi, surtout lorsqu'il est possible de plus être " le nez
dans le guidon" et de pouvoir se détendre avec la remarquable
exactitude qui est tienne !

Pour info : il est possible de déplacer le moyeu lorsque l'ensemble
est en mouvement, ce qui ouvre éventuellement la porte à d'autres
démonstrations cinétiques (par exemple les roues dentées, sens de
rotation, vitesse ....)

Mais à l'arrêt il n'est plus possible de déplacer le moyeu.

Voilà j'ai fait mumuse ;)

Bravo pour cet excellent travail !

Cordialement

Gérard

"garnote" a écrit dans le message de
news:
Bonsoir tout le monde,

Je ne sais pas si l'animation est réaliste mais
les calculs sont corrects. Ça peut servir à
certains profs qui enseignent ce genre de chose.

Je commence à aimer ça, moé, Excel ;-)
A+

Serge

Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Sub Roulement_A_Billes()
'Application mathématique pour
'les techniques industrielles
'Copiez ces deux macros dans un module standard,
'activez une feuille vierge et appelez
'la macro Roulement_A_Billes.
On Error Resume Next
With Application
.DisplayFullScreen = True
.DisplayFormulaBar = False
End With
With ActiveWindow
.DisplayGridlines = False
.DisplayHeadings = False
End With
Set F = ActiveSheet
F.DrawingObjects.Delete
[A1:C4].ClearContents
[C4].Select
q = InputBox("Entrez le diamètre ( de 100 à 450 ) de la cage" _
& vbLf & "et le nombre de billes ( de 3 à 50 )" _
& vbLf & "séparés par un astérisque.", _
" Roulement à billes", "400 * 10")
If q = "" Then Exit Sub
r = Split(q, "*")
If r(0) < 100 Or r(0) > 450 Then Exit Sub
'Nombre de billes
nb = r(1)
If nb < 3 Or nb > 50 Then Exit Sub
'Centre de la cage
cx1 = 350
cy1 = 240
'Rayon de la cage
gr = r(0) / 2
'Dessine la cage
With F.Shapes.AddShape _
(msoShapeOval, cx1 - gr, cy1 - gr, 2 * gr, 2 * gr)
.Fill.ForeColor.SchemeColor = 22
.Line.Weight = 2
End With
'Angle au centre sous-tendu par
'les tangentes à une des billes
Angle = WorksheetFunction.Radians(360 / nb)
a = Angle / 2
'Rayon des billes
rb = gr * Sin(a) / (1 + Sin(a))
'Dessine les billes
For i = 1 To nb
cx2 = cx1 + (gr - rb) * Cos(2 * i * a)
cy2 = cy1 - (gr - rb) * Sin(2 * i * a)
With F.Shapes.AddShape _
(msoShapeOval, cx2 - rb, cy2 - rb, 2 * rb, 2 * rb)
.Fill.ForeColor.SchemeColor = 1 + Int(56 * Rnd())
.Line.Weight = 1
End With
Next i
With F.DrawingObjects.Group
.Name = "billes"
End With
'Rayon de l'essieu
pr = gr * (1 - Sin(a)) / (1 + Sin(a))
'Dessine l'essieu
With F.Shapes.AddShape _
(msoShapeNoSymbol, cx1 - pr, cy1 - pr, 2 * pr, 2 * pr)
.Fill.ForeColor.SchemeColor = 1 + Int(56 * Rnd())
.Line.Weight = 1
.Name = "essieu"
End With
'Renseignements
[A1] = "Diamètre de la cage :"
[C1] = 2 * gr
[A2] = "Nombre de billes :"
[C2] = nb
[A3] = "Diamètre de l'essieu :"
[C3] = 2 * pr
[A4] = "Diamètre des billes :"
[C4] = 2 * rb
'Appelle la macro Tourne pour l'animation
'Pour annuler l'animation, mettre ' devant Tourne
Tourne
'Groupe le tout
F.DrawingObjects.Group
'garnote, août 2005
End Sub

Sub Tourne()
'Vous pouvez changer ces paramètres
rb = -3
re = 1
s = 20
'Animation
For i = 1 To 360
ActiveSheet.Shapes("billes").IncrementRotation rb
ActiveSheet.Shapes("essieu").IncrementRotation re
DoEvents
Sleep (s)
Next i
End Sub

--
n'oubliez pas les FAQ :
http://www.excelabo.net http://dj.joss.free.fr/faq.htm
http://www.faqoe.com http://faqword.free.fr
--
Feed Back
http://viadresse.com/?94912042

G. L

20/08/2005 à 14:21

Bonsour gamma60
Modeste a été plus rapide et plus didactique que moi !

Cordialement
Gérard

"gamma60" a écrit dans le message de
news:%

bonjour
dans sub tourne(), je bute sur "sleep (s)"
comme je ne connais pas ....je ne vois pas quoi faire pour contourner le
probléme
un coup de main ???
je suis frustrée
merci

--
gamma60

In news:,
G. <sugere~KillPub~@online.fr> typed:
Bonsoir Serge,

Je commence à aimer ça, moé, Excel ;-)

Et moé aussi, surtout lorsqu'il est possible de plus être " le nez
dans le guidon" et de pouvoir se détendre avec la remarquable
exactitude qui est tienne !

Pour info : il est possible de déplacer le moyeu lorsque l'ensemble
est en mouvement, ce qui ouvre éventuellement la porte à d'autres
démonstrations cinétiques (par exemple les roues dentées, sens de
rotation, vitesse ....)

Mais à l'arrêt il n'est plus possible de déplacer le moyeu.

Voilà j'ai fait mumuse ;)

Bravo pour cet excellent travail !

Cordialement

Gérard

"garnote" a écrit dans le message de
news:
Bonsoir tout le monde,

Je ne sais pas si l'animation est réaliste mais
les calculs sont corrects. Ça peut servir à
certains profs qui enseignent ce genre de chose.

Je commence à aimer ça, moé, Excel ;-)
A+

Serge

Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Sub Roulement_A_Billes()
'Application mathématique pour
'les techniques industrielles
'Copiez ces deux macros dans un module standard,
'activez une feuille vierge et appelez
'la macro Roulement_A_Billes.
On Error Resume Next
With Application
.DisplayFullScreen = True
.DisplayFormulaBar = False
End With
With ActiveWindow
.DisplayGridlines = False
.DisplayHeadings = False
End With
Set F = ActiveSheet
F.DrawingObjects.Delete
[A1:C4].ClearContents
[C4].Select
q = InputBox("Entrez le diamètre ( de 100 à 450 ) de la cage" _
& vbLf & "et le nombre de billes ( de 3 à 50 )" _
& vbLf & "séparés par un astérisque.", _
" Roulement à billes", "400 * 10")
If q = "" Then Exit Sub
r = Split(q, "*")
If r(0) < 100 Or r(0) > 450 Then Exit Sub
'Nombre de billes
nb = r(1)
If nb < 3 Or nb > 50 Then Exit Sub
'Centre de la cage
cx1 = 350
cy1 = 240
'Rayon de la cage
gr = r(0) / 2
'Dessine la cage
With F.Shapes.AddShape _
(msoShapeOval, cx1 - gr, cy1 - gr, 2 * gr, 2 * gr)
.Fill.ForeColor.SchemeColor = 22
.Line.Weight = 2
End With
'Angle au centre sous-tendu par
'les tangentes à une des billes
Angle = WorksheetFunction.Radians(360 / nb)
a = Angle / 2
'Rayon des billes
rb = gr * Sin(a) / (1 + Sin(a))
'Dessine les billes
For i = 1 To nb
cx2 = cx1 + (gr - rb) * Cos(2 * i * a)
cy2 = cy1 - (gr - rb) * Sin(2 * i * a)
With F.Shapes.AddShape _
(msoShapeOval, cx2 - rb, cy2 - rb, 2 * rb, 2 * rb)
.Fill.ForeColor.SchemeColor = 1 + Int(56 * Rnd())
.Line.Weight = 1
End With
Next i
With F.DrawingObjects.Group
.Name = "billes"
End With
'Rayon de l'essieu
pr = gr * (1 - Sin(a)) / (1 + Sin(a))
'Dessine l'essieu
With F.Shapes.AddShape _
(msoShapeNoSymbol, cx1 - pr, cy1 - pr, 2 * pr, 2 * pr)
.Fill.ForeColor.SchemeColor = 1 + Int(56 * Rnd())
.Line.Weight = 1
.Name = "essieu"
End With
'Renseignements
[A1] = "Diamètre de la cage :"
[C1] = 2 * gr
[A2] = "Nombre de billes :"
[C2] = nb
[A3] = "Diamètre de l'essieu :"
[C3] = 2 * pr
[A4] = "Diamètre des billes :"
[C4] = 2 * rb
'Appelle la macro Tourne pour l'animation
'Pour annuler l'animation, mettre ' devant Tourne
Tourne
'Groupe le tout
F.DrawingObjects.Group
'garnote, août 2005
End Sub

Sub Tourne()
'Vous pouvez changer ces paramètres
rb = -3
re = 1
s = 20
'Animation
For i = 1 To 360
ActiveSheet.Shapes("billes").IncrementRotation rb
ActiveSheet.Shapes("essieu").IncrementRotation re
DoEvents
Sleep (s)
Next i
End Sub

Bonsour gamma60
Modeste a été plus rapide et plus didactique que moi !

Cordialement
Gérard

"gamma60" <gamma60@.free.fr> a écrit dans le message de
news:%23dM8OFXpFHA.2976@TK2MSFTNGP12.phx.gbl...

bonjour
dans sub tourne(), je bute sur "sleep (s)"
comme je ne connais pas ....je ne vois pas quoi faire pour contourner le
probléme
un coup de main ???
je suis frustrée
merci

--
gamma60

In news:eAs5sYPpFHA.3756@TK2MSFTNGP09.phx.gbl,
G. L@rumeur <sugere~KillPub~@online.fr> typed:

Bonsoir Serge,

Je commence à aimer ça, moé, Excel ;-)

Et moé aussi, surtout lorsqu'il est possible de plus être " le nez
dans le guidon" et de pouvoir se détendre avec la remarquable
exactitude qui est tienne !

Pour info : il est possible de déplacer le moyeu lorsque l'ensemble
est en mouvement, ce qui ouvre éventuellement la porte à d'autres
démonstrations cinétiques (par exemple les roues dentées, sens de
rotation, vitesse ....)

Mais à l'arrêt il n'est plus possible de déplacer le moyeu.

Voilà j'ai fait mumuse ;)

Bravo pour cet excellent travail !

Cordialement

Gérard

"garnote" <rien@absent.com> a écrit dans le message de
news:uuuYWZNpFHA.3036@TK2MSFTNGP14.phx.gbl...

Bonsoir tout le monde,

Je ne sais pas si l'animation est réaliste mais
les calculs sont corrects. Ça peut servir à
certains profs qui enseignent ce genre de chose.

Je commence à aimer ça, moé, Excel ;-)
A+

Serge

Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Sub Roulement_A_Billes()
'Application mathématique pour
'les techniques industrielles
'Copiez ces deux macros dans un module standard,
'activez une feuille vierge et appelez
'la macro Roulement_A_Billes.
On Error Resume Next
With Application
.DisplayFullScreen = True
.DisplayFormulaBar = False
End With
With ActiveWindow
.DisplayGridlines = False
.DisplayHeadings = False
End With
Set F = ActiveSheet
F.DrawingObjects.Delete
[A1:C4].ClearContents
[C4].Select
q = InputBox("Entrez le diamètre ( de 100 à 450 ) de la cage" _
& vbLf & "et le nombre de billes ( de 3 à 50 )" _
& vbLf & "séparés par un astérisque.", _
" Roulement à billes", "400 * 10")
If q = "" Then Exit Sub
r = Split(q, "*")
If r(0) < 100 Or r(0) > 450 Then Exit Sub
'Nombre de billes
nb = r(1)
If nb < 3 Or nb > 50 Then Exit Sub
'Centre de la cage
cx1 = 350
cy1 = 240
'Rayon de la cage
gr = r(0) / 2
'Dessine la cage
With F.Shapes.AddShape _
(msoShapeOval, cx1 - gr, cy1 - gr, 2 * gr, 2 * gr)
.Fill.ForeColor.SchemeColor = 22
.Line.Weight = 2
End With
'Angle au centre sous-tendu par
'les tangentes à une des billes
Angle = WorksheetFunction.Radians(360 / nb)
a = Angle / 2
'Rayon des billes
rb = gr * Sin(a) / (1 + Sin(a))
'Dessine les billes
For i = 1 To nb
cx2 = cx1 + (gr - rb) * Cos(2 * i * a)
cy2 = cy1 - (gr - rb) * Sin(2 * i * a)
With F.Shapes.AddShape _
(msoShapeOval, cx2 - rb, cy2 - rb, 2 * rb, 2 * rb)
.Fill.ForeColor.SchemeColor = 1 + Int(56 * Rnd())
.Line.Weight = 1
End With
Next i
With F.DrawingObjects.Group
.Name = "billes"
End With
'Rayon de l'essieu
pr = gr * (1 - Sin(a)) / (1 + Sin(a))
'Dessine l'essieu
With F.Shapes.AddShape _
(msoShapeNoSymbol, cx1 - pr, cy1 - pr, 2 * pr, 2 * pr)
.Fill.ForeColor.SchemeColor = 1 + Int(56 * Rnd())
.Line.Weight = 1
.Name = "essieu"
End With
'Renseignements
[A1] = "Diamètre de la cage :"
[C1] = 2 * gr
[A2] = "Nombre de billes :"
[C2] = nb
[A3] = "Diamètre de l'essieu :"
[C3] = 2 * pr
[A4] = "Diamètre des billes :"
[C4] = 2 * rb
'Appelle la macro Tourne pour l'animation
'Pour annuler l'animation, mettre ' devant Tourne
Tourne
'Groupe le tout
F.DrawingObjects.Group
'garnote, août 2005
End Sub

Sub Tourne()
'Vous pouvez changer ces paramètres
rb = -3
re = 1
s = 20
'Animation
For i = 1 To 360
ActiveSheet.Shapes("billes").IncrementRotation rb
ActiveSheet.Shapes("essieu").IncrementRotation re
DoEvents
Sleep (s)
Next i
End Sub

Vous avez filtré cet utilisateur ! Consultez son message

Bonsour gamma60
Modeste a été plus rapide et plus didactique que moi !

Cordialement
Gérard

"gamma60" a écrit dans le message de
news:%

bonjour
dans sub tourne(), je bute sur "sleep (s)"
comme je ne connais pas ....je ne vois pas quoi faire pour contourner le
probléme
un coup de main ???
je suis frustrée
merci

--
gamma60

In news:,
G. <sugere~KillPub~@online.fr> typed:
Bonsoir Serge,

Je commence à aimer ça, moé, Excel ;-)

Et moé aussi, surtout lorsqu'il est possible de plus être " le nez
dans le guidon" et de pouvoir se détendre avec la remarquable
exactitude qui est tienne !

Pour info : il est possible de déplacer le moyeu lorsque l'ensemble
est en mouvement, ce qui ouvre éventuellement la porte à d'autres
démonstrations cinétiques (par exemple les roues dentées, sens de
rotation, vitesse ....)

Mais à l'arrêt il n'est plus possible de déplacer le moyeu.

Voilà j'ai fait mumuse ;)

Bravo pour cet excellent travail !

Cordialement

Gérard

"garnote" a écrit dans le message de
news:
Bonsoir tout le monde,

Je ne sais pas si l'animation est réaliste mais
les calculs sont corrects. Ça peut servir à
certains profs qui enseignent ce genre de chose.

Je commence à aimer ça, moé, Excel ;-)
A+

Serge

Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Sub Roulement_A_Billes()
'Application mathématique pour
'les techniques industrielles
'Copiez ces deux macros dans un module standard,
'activez une feuille vierge et appelez
'la macro Roulement_A_Billes.
On Error Resume Next
With Application
.DisplayFullScreen = True
.DisplayFormulaBar = False
End With
With ActiveWindow
.DisplayGridlines = False
.DisplayHeadings = False
End With
Set F = ActiveSheet
F.DrawingObjects.Delete
[A1:C4].ClearContents
[C4].Select
q = InputBox("Entrez le diamètre ( de 100 à 450 ) de la cage" _
& vbLf & "et le nombre de billes ( de 3 à 50 )" _
& vbLf & "séparés par un astérisque.", _
" Roulement à billes", "400 * 10")
If q = "" Then Exit Sub
r = Split(q, "*")
If r(0) < 100 Or r(0) > 450 Then Exit Sub
'Nombre de billes
nb = r(1)
If nb < 3 Or nb > 50 Then Exit Sub
'Centre de la cage
cx1 = 350
cy1 = 240
'Rayon de la cage
gr = r(0) / 2
'Dessine la cage
With F.Shapes.AddShape _
(msoShapeOval, cx1 - gr, cy1 - gr, 2 * gr, 2 * gr)
.Fill.ForeColor.SchemeColor = 22
.Line.Weight = 2
End With
'Angle au centre sous-tendu par
'les tangentes à une des billes
Angle = WorksheetFunction.Radians(360 / nb)
a = Angle / 2
'Rayon des billes
rb = gr * Sin(a) / (1 + Sin(a))
'Dessine les billes
For i = 1 To nb
cx2 = cx1 + (gr - rb) * Cos(2 * i * a)
cy2 = cy1 - (gr - rb) * Sin(2 * i * a)
With F.Shapes.AddShape _
(msoShapeOval, cx2 - rb, cy2 - rb, 2 * rb, 2 * rb)
.Fill.ForeColor.SchemeColor = 1 + Int(56 * Rnd())
.Line.Weight = 1
End With
Next i
With F.DrawingObjects.Group
.Name = "billes"
End With
'Rayon de l'essieu
pr = gr * (1 - Sin(a)) / (1 + Sin(a))
'Dessine l'essieu
With F.Shapes.AddShape _
(msoShapeNoSymbol, cx1 - pr, cy1 - pr, 2 * pr, 2 * pr)
.Fill.ForeColor.SchemeColor = 1 + Int(56 * Rnd())
.Line.Weight = 1
.Name = "essieu"
End With
'Renseignements
[A1] = "Diamètre de la cage :"
[C1] = 2 * gr
[A2] = "Nombre de billes :"
[C2] = nb
[A3] = "Diamètre de l'essieu :"
[C3] = 2 * pr
[A4] = "Diamètre des billes :"
[C4] = 2 * rb
'Appelle la macro Tourne pour l'animation
'Pour annuler l'animation, mettre ' devant Tourne
Tourne
'Groupe le tout
F.DrawingObjects.Group
'garnote, août 2005
End Sub

Sub Tourne()
'Vous pouvez changer ces paramètres
rb = -3
re = 1
s = 20
'Animation
For i = 1 To 360
ActiveSheet.Shapes("billes").IncrementRotation rb
ActiveSheet.Shapes("essieu").IncrementRotation re
DoEvents
Sleep (s)
Next i
End Sub

gamma60

20/08/2005 à 16:14

et hop ! dans mon bloc-notes astuces VBA
et..... ça roule ....

merci Modeste
merci Gérard

--
gamma60

garnote

21/08/2005 à 02:15

Bonjour,

Content de savoir que ce genre de folies
puisse provoquer de telles réactions.

Merci,
moé

"Charles Ingals" a écrit dans le message de
news: 430618fb$0$3147$

Bonsoir,
Un seul mot : superbe.
Très beau travail.
@+ et bonne soirée.
"garnote" a écrit dans le message de news:

Bonsoir tout le monde,

Je ne sais pas si l'animation est réaliste mais
les calculs sont corrects. Ça peut servir à
certains profs qui enseignent ce genre de chose.

Je commence à aimer ça, moé, Excel ;-)
A+

Serge

Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Sub Roulement_A_Billes()
'Application mathématique pour
'les techniques industrielles
'Copiez ces deux macros dans un module standard,
'activez une feuille vierge et appelez
'la macro Roulement_A_Billes.
On Error Resume Next
With Application
.DisplayFullScreen = True
.DisplayFormulaBar = False
End With
With ActiveWindow
.DisplayGridlines = False
.DisplayHeadings = False
End With
Set F = ActiveSheet
F.DrawingObjects.Delete
[A1:C4].ClearContents
[C4].Select
q = InputBox("Entrez le diamètre ( de 100 à 450 ) de la cage" _
& vbLf & "et le nombre de billes ( de 3 à 50 )" _
& vbLf & "séparés par un astérisque.", _
" Roulement à billes", "400 * 10")
If q = "" Then Exit Sub
r = Split(q, "*")
If r(0) < 100 Or r(0) > 450 Then Exit Sub
'Nombre de billes
nb = r(1)
If nb < 3 Or nb > 50 Then Exit Sub
'Centre de la cage
cx1 = 350
cy1 = 240
'Rayon de la cage
gr = r(0) / 2
'Dessine la cage
With F.Shapes.AddShape _
(msoShapeOval, cx1 - gr, cy1 - gr, 2 * gr, 2 * gr)
.Fill.ForeColor.SchemeColor = 22
.Line.Weight = 2
End With
'Angle au centre sous-tendu par
'les tangentes à une des billes
Angle = WorksheetFunction.Radians(360 / nb)
a = Angle / 2
'Rayon des billes
rb = gr * Sin(a) / (1 + Sin(a))
'Dessine les billes
For i = 1 To nb
cx2 = cx1 + (gr - rb) * Cos(2 * i * a)
cy2 = cy1 - (gr - rb) * Sin(2 * i * a)
With F.Shapes.AddShape _
(msoShapeOval, cx2 - rb, cy2 - rb, 2 * rb, 2 * rb)
.Fill.ForeColor.SchemeColor = 1 + Int(56 * Rnd())
.Line.Weight = 1
End With
Next i
With F.DrawingObjects.Group
.Name = "billes"
End With
'Rayon de l'essieu
pr = gr * (1 - Sin(a)) / (1 + Sin(a))
'Dessine l'essieu
With F.Shapes.AddShape _
(msoShapeNoSymbol, cx1 - pr, cy1 - pr, 2 * pr, 2 * pr)
.Fill.ForeColor.SchemeColor = 1 + Int(56 * Rnd())
.Line.Weight = 1
.Name = "essieu"
End With
'Renseignements
[A1] = "Diamètre de la cage :"
[C1] = 2 * gr
[A2] = "Nombre de billes :"
[C2] = nb
[A3] = "Diamètre de l'essieu :"
[C3] = 2 * pr
[A4] = "Diamètre des billes :"
[C4] = 2 * rb
'Appelle la macro Tourne pour l'animation
'Pour annuler l'animation, mettre ' devant Tourne
Tourne
'Groupe le tout
F.DrawingObjects.Group
'garnote, août 2005
End Sub

Sub Tourne()
'Vous pouvez changer ces paramètres
rb = -3
re = 1
s = 20
'Animation
For i = 1 To 360
ActiveSheet.Shapes("billes").IncrementRotation rb
ActiveSheet.Shapes("essieu").IncrementRotation re
DoEvents
Sleep (s)
Next i
End Sub

Bonjour,

Content de savoir que ce genre de folies
puisse provoquer de telles réactions.

Merci,
moé

"Charles Ingals" <charles.ingals@wanadoo.fr> a écrit dans le message de
news: 430618fb$0$3147$8fcfb975@news.wanadoo.fr...

Bonsoir,
Un seul mot : superbe.
Très beau travail.
@+ et bonne soirée.
"garnote" <rien@absent.com> a écrit dans le message de news:
uuuYWZNpFHA.3036@TK2MSFTNGP14.phx.gbl...

Bonsoir tout le monde,

Je ne sais pas si l'animation est réaliste mais
les calculs sont corrects. Ça peut servir à
certains profs qui enseignent ce genre de chose.

Je commence à aimer ça, moé, Excel ;-)
A+

Serge

Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Sub Roulement_A_Billes()
'Application mathématique pour
'les techniques industrielles
'Copiez ces deux macros dans un module standard,
'activez une feuille vierge et appelez
'la macro Roulement_A_Billes.
On Error Resume Next
With Application
.DisplayFullScreen = True
.DisplayFormulaBar = False
End With
With ActiveWindow
.DisplayGridlines = False
.DisplayHeadings = False
End With
Set F = ActiveSheet
F.DrawingObjects.Delete
[A1:C4].ClearContents
[C4].Select
q = InputBox("Entrez le diamètre ( de 100 à 450 ) de la cage" _
& vbLf & "et le nombre de billes ( de 3 à 50 )" _
& vbLf & "séparés par un astérisque.", _
" Roulement à billes", "400 * 10")
If q = "" Then Exit Sub
r = Split(q, "*")
If r(0) < 100 Or r(0) > 450 Then Exit Sub
'Nombre de billes
nb = r(1)
If nb < 3 Or nb > 50 Then Exit Sub
'Centre de la cage
cx1 = 350
cy1 = 240
'Rayon de la cage
gr = r(0) / 2
'Dessine la cage
With F.Shapes.AddShape _
(msoShapeOval, cx1 - gr, cy1 - gr, 2 * gr, 2 * gr)
.Fill.ForeColor.SchemeColor = 22
.Line.Weight = 2
End With
'Angle au centre sous-tendu par
'les tangentes à une des billes
Angle = WorksheetFunction.Radians(360 / nb)
a = Angle / 2
'Rayon des billes
rb = gr * Sin(a) / (1 + Sin(a))
'Dessine les billes
For i = 1 To nb
cx2 = cx1 + (gr - rb) * Cos(2 * i * a)
cy2 = cy1 - (gr - rb) * Sin(2 * i * a)
With F.Shapes.AddShape _
(msoShapeOval, cx2 - rb, cy2 - rb, 2 * rb, 2 * rb)
.Fill.ForeColor.SchemeColor = 1 + Int(56 * Rnd())
.Line.Weight = 1
End With
Next i
With F.DrawingObjects.Group
.Name = "billes"
End With
'Rayon de l'essieu
pr = gr * (1 - Sin(a)) / (1 + Sin(a))
'Dessine l'essieu
With F.Shapes.AddShape _
(msoShapeNoSymbol, cx1 - pr, cy1 - pr, 2 * pr, 2 * pr)
.Fill.ForeColor.SchemeColor = 1 + Int(56 * Rnd())
.Line.Weight = 1
.Name = "essieu"
End With
'Renseignements
[A1] = "Diamètre de la cage :"
[C1] = 2 * gr
[A2] = "Nombre de billes :"
[C2] = nb
[A3] = "Diamètre de l'essieu :"
[C3] = 2 * pr
[A4] = "Diamètre des billes :"
[C4] = 2 * rb
'Appelle la macro Tourne pour l'animation
'Pour annuler l'animation, mettre ' devant Tourne
Tourne
'Groupe le tout
F.DrawingObjects.Group
'garnote, août 2005
End Sub

Sub Tourne()
'Vous pouvez changer ces paramètres
rb = -3
re = 1
s = 20
'Animation
For i = 1 To 360
ActiveSheet.Shapes("billes").IncrementRotation rb
ActiveSheet.Shapes("essieu").IncrementRotation re
DoEvents
Sleep (s)
Next i
End Sub

Vous avez filtré cet utilisateur ! Consultez son message

Bonjour,

Content de savoir que ce genre de folies
puisse provoquer de telles réactions.

Merci,
moé

"Charles Ingals" a écrit dans le message de
news: 430618fb$0$3147$

Bonsoir,
Un seul mot : superbe.
Très beau travail.
@+ et bonne soirée.
"garnote" a écrit dans le message de news:

Bonsoir tout le monde,

Je ne sais pas si l'animation est réaliste mais
les calculs sont corrects. Ça peut servir à
certains profs qui enseignent ce genre de chose.

Je commence à aimer ça, moé, Excel ;-)
A+

Serge

Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Sub Roulement_A_Billes()
'Application mathématique pour
'les techniques industrielles
'Copiez ces deux macros dans un module standard,
'activez une feuille vierge et appelez
'la macro Roulement_A_Billes.
On Error Resume Next
With Application
.DisplayFullScreen = True
.DisplayFormulaBar = False
End With
With ActiveWindow
.DisplayGridlines = False
.DisplayHeadings = False
End With
Set F = ActiveSheet
F.DrawingObjects.Delete
[A1:C4].ClearContents
[C4].Select
q = InputBox("Entrez le diamètre ( de 100 à 450 ) de la cage" _
& vbLf & "et le nombre de billes ( de 3 à 50 )" _
& vbLf & "séparés par un astérisque.", _
" Roulement à billes", "400 * 10")
If q = "" Then Exit Sub
r = Split(q, "*")
If r(0) < 100 Or r(0) > 450 Then Exit Sub
'Nombre de billes
nb = r(1)
If nb < 3 Or nb > 50 Then Exit Sub
'Centre de la cage
cx1 = 350
cy1 = 240
'Rayon de la cage
gr = r(0) / 2
'Dessine la cage
With F.Shapes.AddShape _
(msoShapeOval, cx1 - gr, cy1 - gr, 2 * gr, 2 * gr)
.Fill.ForeColor.SchemeColor = 22
.Line.Weight = 2
End With
'Angle au centre sous-tendu par
'les tangentes à une des billes
Angle = WorksheetFunction.Radians(360 / nb)
a = Angle / 2
'Rayon des billes
rb = gr * Sin(a) / (1 + Sin(a))
'Dessine les billes
For i = 1 To nb
cx2 = cx1 + (gr - rb) * Cos(2 * i * a)
cy2 = cy1 - (gr - rb) * Sin(2 * i * a)
With F.Shapes.AddShape _
(msoShapeOval, cx2 - rb, cy2 - rb, 2 * rb, 2 * rb)
.Fill.ForeColor.SchemeColor = 1 + Int(56 * Rnd())
.Line.Weight = 1
End With
Next i
With F.DrawingObjects.Group
.Name = "billes"
End With
'Rayon de l'essieu
pr = gr * (1 - Sin(a)) / (1 + Sin(a))
'Dessine l'essieu
With F.Shapes.AddShape _
(msoShapeNoSymbol, cx1 - pr, cy1 - pr, 2 * pr, 2 * pr)
.Fill.ForeColor.SchemeColor = 1 + Int(56 * Rnd())
.Line.Weight = 1
.Name = "essieu"
End With
'Renseignements
[A1] = "Diamètre de la cage :"
[C1] = 2 * gr
[A2] = "Nombre de billes :"
[C2] = nb
[A3] = "Diamètre de l'essieu :"
[C3] = 2 * pr
[A4] = "Diamètre des billes :"
[C4] = 2 * rb
'Appelle la macro Tourne pour l'animation
'Pour annuler l'animation, mettre ' devant Tourne
Tourne
'Groupe le tout
F.DrawingObjects.Group
'garnote, août 2005
End Sub

Sub Tourne()
'Vous pouvez changer ces paramètres
rb = -3
re = 1
s = 20
'Animation
For i = 1 To 360
ActiveSheet.Shapes("billes").IncrementRotation rb
ActiveSheet.Shapes("essieu").IncrementRotation re
DoEvents
Sleep (s)
Next i
End Sub

Laurent Daures

21/08/2005 à 20:47

Bonjour serge,
superbe, ce qui m'intéresse moi, c'est l'animation, la coloration,
voici une petite modification qui me semble jolie.
Attention l'abus de cette macro peut entraîner des troubles chez les sujets
épileptiques.
Des troubles occulaires semblent normaux mais l'absence
de troubles mentaux n'est pas garantie;-))

Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Sub Roulement_A_Billes()
'Application mathématique pour
'les techniques industrielles
'Copiez ces deux macros dans un module standard,
'activez une feuille vierge et appelez
'la macro Roulement_A_Billes.
On Error Resume Next
With Application
.DisplayFullScreen = True
.DisplayFormulaBar = False
End With
With ActiveWindow
.DisplayGridlines = False
.DisplayHeadings = False
End With
Set F = ActiveSheet
F.DrawingObjects.Delete
[A1:C4].ClearContents
[C4].Select
q = InputBox("Entrez le diamètre ( de 100 à 450 ) de la cage" _
& vbLf & "et le nombre de billes ( de 3 à 50 )" _
& vbLf & "séparés par un astérisque.", _
" Roulement à billes", "400 * 10")
If q = "" Then Exit Sub
r = Split(q, "*")
If r(0) < 100 Or r(0) > 450 Then Exit Sub
'Nombre de billes
nb = r(1)
If nb < 3 Or nb > 50 Then Exit Sub
'Centre de la cage
cx1 = 350
cy1 = 240
'Rayon de la cage
gr = r(0) / 2
'Dessine la cage
With F.Shapes.AddShape _
(msoShapeOval, cx1 - gr, cy1 - gr, 2 * gr, 2 * gr)
.Fill.ForeColor.SchemeColor = 22
.Line.Weight = 2
.Name = "roue"
End With
'Angle au centre sous-tendu par
'les tangentes à une des billes
Angle = WorksheetFunction.Radians(360 / nb)
a = Angle / 2
'Rayon des billes
rb = gr * Sin(a) / (1 + Sin(a))
'Dessine les billes
For i = 1 To nb
cx2 = cx1 + (gr - rb) * Cos(2 * i * a)
cy2 = cy1 - (gr - rb) * Sin(2 * i * a)
With F.Shapes.AddShape _
(msoShapeOval, cx2 - rb, cy2 - rb, 2 * rb, 2 * rb)
.Fill.ForeColor.SchemeColor = 1 + Int(56 * Rnd())
.Line.Weight = 1
.Name = "bille" & i
End With
Next i
With F.DrawingObjects.Group
.Name = "billes"
End With
'Rayon de l'essieu
pr = gr * (1 - Sin(a)) / (1 + Sin(a))
'Dessine l'essieu
With F.Shapes.AddShape _
(msoShapeNoSymbol, cx1 - pr, cy1 - pr, 2 * pr, 2 * pr)
.Fill.ForeColor.SchemeColor = 1 + Int(56 * Rnd())
.Line.Weight = 1
.Name = "essieu"
End With
'Renseignements
[A1] = "Diamètre de la cage :"
[C1] = 2 * gr
[A2] = "Nombre de billes :"
[C2] = nb
[A3] = "Diamètre de l'essieu :"
[C3] = 2 * pr
[A4] = "Diamètre des billes :"
[C4] = 2 * rb
'Appelle la macro Tourne pour l'animation
'Pour annuler l'animation, mettre ' devant Tourne
Tourne
'Groupe le tout
'garnote, août 2005
End Sub

Sub LOLO()
h = ActiveSheet.Shapes("billes").Top
Selection.ShapeRange.Group.Select
Selection.Name = "billes"
ActiveSheet.Shapes("billes").Top = h
End Sub

Sub Tourne()
'Vous pouvez changer ces paramètres
rb = -3
re = 2
s = 20
'Animation
For i = 1 To 360
ActiveSheet.Shapes("Billes").IncrementRotation rb
ActiveSheet.Shapes("essieu").IncrementRotation re
ActiveSheet.Shapes("Billes").Select
Selection.ShapeRange.Ungroup.Select
ActiveSheet.Shapes("roue").Fill.ForeColor.SchemeColor = Int(Rnd() * 55)
+ 1
For y = 1 To ActiveSheet.Shapes.Count
' MsgBox Selection.Name
If ActiveSheet.Shapes(y).Name <> "essieu" Then
On Error Resume Next
ActiveSheet.Shapes("bille" & y).Fill.ForeColor.SchemeColor = Int(Rnd() *
55) + 1
End If
Next
LOLO
ActiveSheet.Shapes("essieu").Select
Selection.ShapeRange.Fill.ForeColor.SchemeColor = Int(Rnd() * 55) + 1
DoEvents
Sleep (s)
Next i
End Sub

Amicalement
Sitting Hoax

"garnote" a écrit dans le message de news:

Bonjour,

Content de savoir que ce genre de folies
puisse provoquer de telles réactions.

Merci,
moé

"Charles Ingals" a écrit dans le message de
news: 430618fb$0$3147$
Bonsoir,
Un seul mot : superbe.
Très beau travail.
@+ et bonne soirée.
"garnote" a écrit dans le message de news:

Bonsoir tout le monde,

Je ne sais pas si l'animation est réaliste mais
les calculs sont corrects. Ça peut servir à
certains profs qui enseignent ce genre de chose.

Je commence à aimer ça, moé, Excel ;-)
A+

Serge

Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Sub Roulement_A_Billes()
'Application mathématique pour
'les techniques industrielles
'Copiez ces deux macros dans un module standard,
'activez une feuille vierge et appelez
'la macro Roulement_A_Billes.
On Error Resume Next
With Application
.DisplayFullScreen = True
.DisplayFormulaBar = False
End With
With ActiveWindow
.DisplayGridlines = False
.DisplayHeadings = False
End With
Set F = ActiveSheet
F.DrawingObjects.Delete
[A1:C4].ClearContents
[C4].Select
q = InputBox("Entrez le diamètre ( de 100 à 450 ) de la cage" _
& vbLf & "et le nombre de billes ( de 3 à 50 )" _
& vbLf & "séparés par un astérisque.", _
" Roulement à billes", "400 * 10")
If q = "" Then Exit Sub
r = Split(q, "*")
If r(0) < 100 Or r(0) > 450 Then Exit Sub
'Nombre de billes
nb = r(1)
If nb < 3 Or nb > 50 Then Exit Sub
'Centre de la cage
cx1 = 350
cy1 = 240
'Rayon de la cage
gr = r(0) / 2
'Dessine la cage
With F.Shapes.AddShape _
(msoShapeOval, cx1 - gr, cy1 - gr, 2 * gr, 2 * gr)
.Fill.ForeColor.SchemeColor = 22
.Line.Weight = 2
End With
'Angle au centre sous-tendu par
'les tangentes à une des billes
Angle = WorksheetFunction.Radians(360 / nb)
a = Angle / 2
'Rayon des billes
rb = gr * Sin(a) / (1 + Sin(a))
'Dessine les billes
For i = 1 To nb
cx2 = cx1 + (gr - rb) * Cos(2 * i * a)
cy2 = cy1 - (gr - rb) * Sin(2 * i * a)
With F.Shapes.AddShape _
(msoShapeOval, cx2 - rb, cy2 - rb, 2 * rb, 2 * rb)
.Fill.ForeColor.SchemeColor = 1 + Int(56 * Rnd())
.Line.Weight = 1
End With
Next i
With F.DrawingObjects.Group
.Name = "billes"
End With
'Rayon de l'essieu
pr = gr * (1 - Sin(a)) / (1 + Sin(a))
'Dessine l'essieu
With F.Shapes.AddShape _
(msoShapeNoSymbol, cx1 - pr, cy1 - pr, 2 * pr, 2 * pr)
.Fill.ForeColor.SchemeColor = 1 + Int(56 * Rnd())
.Line.Weight = 1
.Name = "essieu"
End With
'Renseignements
[A1] = "Diamètre de la cage :"
[C1] = 2 * gr
[A2] = "Nombre de billes :"
[C2] = nb
[A3] = "Diamètre de l'essieu :"
[C3] = 2 * pr
[A4] = "Diamètre des billes :"
[C4] = 2 * rb
'Appelle la macro Tourne pour l'animation
'Pour annuler l'animation, mettre ' devant Tourne
Tourne
'Groupe le tout
F.DrawingObjects.Group
'garnote, août 2005
End Sub

Sub Tourne()
'Vous pouvez changer ces paramètres
rb = -3
re = 1
s = 20
'Animation
For i = 1 To 360
ActiveSheet.Shapes("billes").IncrementRotation rb
ActiveSheet.Shapes("essieu").IncrementRotation re
DoEvents
Sleep (s)
Next i
End Sub

Bonjour serge,
superbe, ce qui m'intéresse moi, c'est l'animation, la coloration,
voici une petite modification qui me semble jolie.
Attention l'abus de cette macro peut entraîner des troubles chez les sujets
épileptiques.
Des troubles occulaires semblent normaux mais l'absence
de troubles mentaux n'est pas garantie;-))

Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Sub Roulement_A_Billes()
'Application mathématique pour
'les techniques industrielles
'Copiez ces deux macros dans un module standard,
'activez une feuille vierge et appelez
'la macro Roulement_A_Billes.
On Error Resume Next
With Application
.DisplayFullScreen = True
.DisplayFormulaBar = False
End With
With ActiveWindow
.DisplayGridlines = False
.DisplayHeadings = False
End With
Set F = ActiveSheet
F.DrawingObjects.Delete
[A1:C4].ClearContents
[C4].Select
q = InputBox("Entrez le diamètre ( de 100 à 450 ) de la cage" _
& vbLf & "et le nombre de billes ( de 3 à 50 )" _
& vbLf & "séparés par un astérisque.", _
" Roulement à billes", "400 * 10")
If q = "" Then Exit Sub
r = Split(q, "*")
If r(0) < 100 Or r(0) > 450 Then Exit Sub
'Nombre de billes
nb = r(1)
If nb < 3 Or nb > 50 Then Exit Sub
'Centre de la cage
cx1 = 350
cy1 = 240
'Rayon de la cage
gr = r(0) / 2
'Dessine la cage
With F.Shapes.AddShape _
(msoShapeOval, cx1 - gr, cy1 - gr, 2 * gr, 2 * gr)
.Fill.ForeColor.SchemeColor = 22
.Line.Weight = 2
.Name = "roue"
End With
'Angle au centre sous-tendu par
'les tangentes à une des billes
Angle = WorksheetFunction.Radians(360 / nb)
a = Angle / 2
'Rayon des billes
rb = gr * Sin(a) / (1 + Sin(a))
'Dessine les billes
For i = 1 To nb
cx2 = cx1 + (gr - rb) * Cos(2 * i * a)
cy2 = cy1 - (gr - rb) * Sin(2 * i * a)
With F.Shapes.AddShape _
(msoShapeOval, cx2 - rb, cy2 - rb, 2 * rb, 2 * rb)
.Fill.ForeColor.SchemeColor = 1 + Int(56 * Rnd())
.Line.Weight = 1
.Name = "bille" & i
End With
Next i
With F.DrawingObjects.Group
.Name = "billes"
End With
'Rayon de l'essieu
pr = gr * (1 - Sin(a)) / (1 + Sin(a))
'Dessine l'essieu
With F.Shapes.AddShape _
(msoShapeNoSymbol, cx1 - pr, cy1 - pr, 2 * pr, 2 * pr)
.Fill.ForeColor.SchemeColor = 1 + Int(56 * Rnd())
.Line.Weight = 1
.Name = "essieu"
End With
'Renseignements
[A1] = "Diamètre de la cage :"
[C1] = 2 * gr
[A2] = "Nombre de billes :"
[C2] = nb
[A3] = "Diamètre de l'essieu :"
[C3] = 2 * pr
[A4] = "Diamètre des billes :"
[C4] = 2 * rb
'Appelle la macro Tourne pour l'animation
'Pour annuler l'animation, mettre ' devant Tourne
Tourne
'Groupe le tout
'garnote, août 2005
End Sub

Sub LOLO()
h = ActiveSheet.Shapes("billes").Top
Selection.ShapeRange.Group.Select
Selection.Name = "billes"
ActiveSheet.Shapes("billes").Top = h
End Sub

Sub Tourne()
'Vous pouvez changer ces paramètres
rb = -3
re = 2
s = 20
'Animation
For i = 1 To 360
ActiveSheet.Shapes("Billes").IncrementRotation rb
ActiveSheet.Shapes("essieu").IncrementRotation re
ActiveSheet.Shapes("Billes").Select
Selection.ShapeRange.Ungroup.Select
ActiveSheet.Shapes("roue").Fill.ForeColor.SchemeColor = Int(Rnd() * 55)
+ 1
For y = 1 To ActiveSheet.Shapes.Count
' MsgBox Selection.Name
If ActiveSheet.Shapes(y).Name <> "essieu" Then
On Error Resume Next
ActiveSheet.Shapes("bille" & y).Fill.ForeColor.SchemeColor = Int(Rnd() *
55) + 1
End If
Next
LOLO
ActiveSheet.Shapes("essieu").Select
Selection.ShapeRange.Fill.ForeColor.SchemeColor = Int(Rnd() * 55) + 1
DoEvents
Sleep (s)
Next i
End Sub

Amicalement
Sitting Hoax

"garnote" <rien@absent.com> a écrit dans le message de news:
ur7MmVepFHA.2580@TK2MSFTNGP09.phx.gbl...

Bonjour,

Content de savoir que ce genre de folies
puisse provoquer de telles réactions.

Merci,
moé

"Charles Ingals" <charles.ingals@wanadoo.fr> a écrit dans le message de
news: 430618fb$0$3147$8fcfb975@news.wanadoo.fr...

Bonsoir,
Un seul mot : superbe.
Très beau travail.
@+ et bonne soirée.
"garnote" <rien@absent.com> a écrit dans le message de news:
uuuYWZNpFHA.3036@TK2MSFTNGP14.phx.gbl...

Bonsoir tout le monde,

Je ne sais pas si l'animation est réaliste mais
les calculs sont corrects. Ça peut servir à
certains profs qui enseignent ce genre de chose.

Je commence à aimer ça, moé, Excel ;-)
A+

Serge

Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Sub Roulement_A_Billes()
'Application mathématique pour
'les techniques industrielles
'Copiez ces deux macros dans un module standard,
'activez une feuille vierge et appelez
'la macro Roulement_A_Billes.
On Error Resume Next
With Application
.DisplayFullScreen = True
.DisplayFormulaBar = False
End With
With ActiveWindow
.DisplayGridlines = False
.DisplayHeadings = False
End With
Set F = ActiveSheet
F.DrawingObjects.Delete
[A1:C4].ClearContents
[C4].Select
q = InputBox("Entrez le diamètre ( de 100 à 450 ) de la cage" _
& vbLf & "et le nombre de billes ( de 3 à 50 )" _
& vbLf & "séparés par un astérisque.", _
" Roulement à billes", "400 * 10")
If q = "" Then Exit Sub
r = Split(q, "*")
If r(0) < 100 Or r(0) > 450 Then Exit Sub
'Nombre de billes
nb = r(1)
If nb < 3 Or nb > 50 Then Exit Sub
'Centre de la cage
cx1 = 350
cy1 = 240
'Rayon de la cage
gr = r(0) / 2
'Dessine la cage
With F.Shapes.AddShape _
(msoShapeOval, cx1 - gr, cy1 - gr, 2 * gr, 2 * gr)
.Fill.ForeColor.SchemeColor = 22
.Line.Weight = 2
End With
'Angle au centre sous-tendu par
'les tangentes à une des billes
Angle = WorksheetFunction.Radians(360 / nb)
a = Angle / 2
'Rayon des billes
rb = gr * Sin(a) / (1 + Sin(a))
'Dessine les billes
For i = 1 To nb
cx2 = cx1 + (gr - rb) * Cos(2 * i * a)
cy2 = cy1 - (gr - rb) * Sin(2 * i * a)
With F.Shapes.AddShape _
(msoShapeOval, cx2 - rb, cy2 - rb, 2 * rb, 2 * rb)
.Fill.ForeColor.SchemeColor = 1 + Int(56 * Rnd())
.Line.Weight = 1
End With
Next i
With F.DrawingObjects.Group
.Name = "billes"
End With
'Rayon de l'essieu
pr = gr * (1 - Sin(a)) / (1 + Sin(a))
'Dessine l'essieu
With F.Shapes.AddShape _
(msoShapeNoSymbol, cx1 - pr, cy1 - pr, 2 * pr, 2 * pr)
.Fill.ForeColor.SchemeColor = 1 + Int(56 * Rnd())
.Line.Weight = 1
.Name = "essieu"
End With
'Renseignements
[A1] = "Diamètre de la cage :"
[C1] = 2 * gr
[A2] = "Nombre de billes :"
[C2] = nb
[A3] = "Diamètre de l'essieu :"
[C3] = 2 * pr
[A4] = "Diamètre des billes :"
[C4] = 2 * rb
'Appelle la macro Tourne pour l'animation
'Pour annuler l'animation, mettre ' devant Tourne
Tourne
'Groupe le tout
F.DrawingObjects.Group
'garnote, août 2005
End Sub

Sub Tourne()
'Vous pouvez changer ces paramètres
rb = -3
re = 1
s = 20
'Animation
For i = 1 To 360
ActiveSheet.Shapes("billes").IncrementRotation rb
ActiveSheet.Shapes("essieu").IncrementRotation re
DoEvents
Sleep (s)
Next i
End Sub

Vous avez filtré cet utilisateur ! Consultez son message

Bonjour serge,
superbe, ce qui m'intéresse moi, c'est l'animation, la coloration,
voici une petite modification qui me semble jolie.
Attention l'abus de cette macro peut entraîner des troubles chez les sujets
épileptiques.
Des troubles occulaires semblent normaux mais l'absence
de troubles mentaux n'est pas garantie;-))

Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Sub Roulement_A_Billes()
'Application mathématique pour
'les techniques industrielles
'Copiez ces deux macros dans un module standard,
'activez une feuille vierge et appelez
'la macro Roulement_A_Billes.
On Error Resume Next
With Application
.DisplayFullScreen = True
.DisplayFormulaBar = False
End With
With ActiveWindow
.DisplayGridlines = False
.DisplayHeadings = False
End With
Set F = ActiveSheet
F.DrawingObjects.Delete
[A1:C4].ClearContents
[C4].Select
q = InputBox("Entrez le diamètre ( de 100 à 450 ) de la cage" _
& vbLf & "et le nombre de billes ( de 3 à 50 )" _
& vbLf & "séparés par un astérisque.", _
" Roulement à billes", "400 * 10")
If q = "" Then Exit Sub
r = Split(q, "*")
If r(0) < 100 Or r(0) > 450 Then Exit Sub
'Nombre de billes
nb = r(1)
If nb < 3 Or nb > 50 Then Exit Sub
'Centre de la cage
cx1 = 350
cy1 = 240
'Rayon de la cage
gr = r(0) / 2
'Dessine la cage
With F.Shapes.AddShape _
(msoShapeOval, cx1 - gr, cy1 - gr, 2 * gr, 2 * gr)
.Fill.ForeColor.SchemeColor = 22
.Line.Weight = 2
.Name = "roue"
End With
'Angle au centre sous-tendu par
'les tangentes à une des billes
Angle = WorksheetFunction.Radians(360 / nb)
a = Angle / 2
'Rayon des billes
rb = gr * Sin(a) / (1 + Sin(a))
'Dessine les billes
For i = 1 To nb
cx2 = cx1 + (gr - rb) * Cos(2 * i * a)
cy2 = cy1 - (gr - rb) * Sin(2 * i * a)
With F.Shapes.AddShape _
(msoShapeOval, cx2 - rb, cy2 - rb, 2 * rb, 2 * rb)
.Fill.ForeColor.SchemeColor = 1 + Int(56 * Rnd())
.Line.Weight = 1
.Name = "bille" & i
End With
Next i
With F.DrawingObjects.Group
.Name = "billes"
End With
'Rayon de l'essieu
pr = gr * (1 - Sin(a)) / (1 + Sin(a))
'Dessine l'essieu
With F.Shapes.AddShape _
(msoShapeNoSymbol, cx1 - pr, cy1 - pr, 2 * pr, 2 * pr)
.Fill.ForeColor.SchemeColor = 1 + Int(56 * Rnd())
.Line.Weight = 1
.Name = "essieu"
End With
'Renseignements
[A1] = "Diamètre de la cage :"
[C1] = 2 * gr
[A2] = "Nombre de billes :"
[C2] = nb
[A3] = "Diamètre de l'essieu :"
[C3] = 2 * pr
[A4] = "Diamètre des billes :"
[C4] = 2 * rb
'Appelle la macro Tourne pour l'animation
'Pour annuler l'animation, mettre ' devant Tourne
Tourne
'Groupe le tout
'garnote, août 2005
End Sub

Sub LOLO()
h = ActiveSheet.Shapes("billes").Top
Selection.ShapeRange.Group.Select
Selection.Name = "billes"
ActiveSheet.Shapes("billes").Top = h
End Sub

Sub Tourne()
'Vous pouvez changer ces paramètres
rb = -3
re = 2
s = 20
'Animation
For i = 1 To 360
ActiveSheet.Shapes("Billes").IncrementRotation rb
ActiveSheet.Shapes("essieu").IncrementRotation re
ActiveSheet.Shapes("Billes").Select
Selection.ShapeRange.Ungroup.Select
ActiveSheet.Shapes("roue").Fill.ForeColor.SchemeColor = Int(Rnd() * 55)
+ 1
For y = 1 To ActiveSheet.Shapes.Count
' MsgBox Selection.Name
If ActiveSheet.Shapes(y).Name <> "essieu" Then
On Error Resume Next
ActiveSheet.Shapes("bille" & y).Fill.ForeColor.SchemeColor = Int(Rnd() *
55) + 1
End If
Next
LOLO
ActiveSheet.Shapes("essieu").Select
Selection.ShapeRange.Fill.ForeColor.SchemeColor = Int(Rnd() * 55) + 1
DoEvents
Sleep (s)
Next i
End Sub

Amicalement
Sitting Hoax

"garnote" a écrit dans le message de news:

Bonjour,

Content de savoir que ce genre de folies
puisse provoquer de telles réactions.

Merci,
moé

"Charles Ingals" a écrit dans le message de
news: 430618fb$0$3147$
Bonsoir,
Un seul mot : superbe.
Très beau travail.
@+ et bonne soirée.
"garnote" a écrit dans le message de news:

Bonsoir tout le monde,

Je ne sais pas si l'animation est réaliste mais
les calculs sont corrects. Ça peut servir à
certains profs qui enseignent ce genre de chose.

Je commence à aimer ça, moé, Excel ;-)
A+

Serge

Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Sub Roulement_A_Billes()
'Application mathématique pour
'les techniques industrielles
'Copiez ces deux macros dans un module standard,
'activez une feuille vierge et appelez
'la macro Roulement_A_Billes.
On Error Resume Next
With Application
.DisplayFullScreen = True
.DisplayFormulaBar = False
End With
With ActiveWindow
.DisplayGridlines = False
.DisplayHeadings = False
End With
Set F = ActiveSheet
F.DrawingObjects.Delete
[A1:C4].ClearContents
[C4].Select
q = InputBox("Entrez le diamètre ( de 100 à 450 ) de la cage" _
& vbLf & "et le nombre de billes ( de 3 à 50 )" _
& vbLf & "séparés par un astérisque.", _
" Roulement à billes", "400 * 10")
If q = "" Then Exit Sub
r = Split(q, "*")
If r(0) < 100 Or r(0) > 450 Then Exit Sub
'Nombre de billes
nb = r(1)
If nb < 3 Or nb > 50 Then Exit Sub
'Centre de la cage
cx1 = 350
cy1 = 240
'Rayon de la cage
gr = r(0) / 2
'Dessine la cage
With F.Shapes.AddShape _
(msoShapeOval, cx1 - gr, cy1 - gr, 2 * gr, 2 * gr)
.Fill.ForeColor.SchemeColor = 22
.Line.Weight = 2
End With
'Angle au centre sous-tendu par
'les tangentes à une des billes
Angle = WorksheetFunction.Radians(360 / nb)
a = Angle / 2
'Rayon des billes
rb = gr * Sin(a) / (1 + Sin(a))
'Dessine les billes
For i = 1 To nb
cx2 = cx1 + (gr - rb) * Cos(2 * i * a)
cy2 = cy1 - (gr - rb) * Sin(2 * i * a)
With F.Shapes.AddShape _
(msoShapeOval, cx2 - rb, cy2 - rb, 2 * rb, 2 * rb)
.Fill.ForeColor.SchemeColor = 1 + Int(56 * Rnd())
.Line.Weight = 1
End With
Next i
With F.DrawingObjects.Group
.Name = "billes"
End With
'Rayon de l'essieu
pr = gr * (1 - Sin(a)) / (1 + Sin(a))
'Dessine l'essieu
With F.Shapes.AddShape _
(msoShapeNoSymbol, cx1 - pr, cy1 - pr, 2 * pr, 2 * pr)
.Fill.ForeColor.SchemeColor = 1 + Int(56 * Rnd())
.Line.Weight = 1
.Name = "essieu"
End With
'Renseignements
[A1] = "Diamètre de la cage :"
[C1] = 2 * gr
[A2] = "Nombre de billes :"
[C2] = nb
[A3] = "Diamètre de l'essieu :"
[C3] = 2 * pr
[A4] = "Diamètre des billes :"
[C4] = 2 * rb
'Appelle la macro Tourne pour l'animation
'Pour annuler l'animation, mettre ' devant Tourne
Tourne
'Groupe le tout
F.DrawingObjects.Group
'garnote, août 2005
End Sub

Sub Tourne()
'Vous pouvez changer ces paramètres
rb = -3
re = 1
s = 20
'Animation
For i = 1 To 360
ActiveSheet.Shapes("billes").IncrementRotation rb
ActiveSheet.Shapes("essieu").IncrementRotation re
DoEvents
Sleep (s)
Next i
End Sub

[HS] Ça roule

10 réponses

Veuillez sélectionner un problème