Pffff...
l'a même pô d'muzik !!!
ça va BugMan ???
fini le béton ???
;o)))
Pffff...
l'a même pô d'muzik !!!
ça va BugMan ???
fini le béton ???
;o)))
Pffff...
l'a même pô d'muzik !!!
ça va BugMan ???
fini le béton ???
;o)))
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
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
Veux-tu nous rendre fous ? ;-)))
Serge
"Laurent Daures" <http://cerbermail.com/?GSQ36o9bFb> a écrit dans le
message de news: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
Veux-tu nous rendre fous ? ;-)))
Serge
"Laurent Daures" <http://cerbermail.com/?GSQ36o9bFb> a écrit dans le
message de news: OfTMUDopFHA.3380@TK2MSFTNGP10.phx.gbl...
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
Veux-tu nous rendre fous ? ;-)))
Serge
"Laurent Daures" <http://cerbermail.com/?GSQ36o9bFb> a écrit dans le
message de news: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
