Quelle macro saura me donner les 2399 premières décimales du nombre PI ?
Sub Pi()
'Les 2 399 premières décimales de Pi
Dim a, b, c, d, e, g As Long
Dim f(8401) As Long
Dim rep As String
Dim ch As String
rep = ""
a = 10000
c = 8400
While b <> c
f(b) = Int(a / 5)
b = b + 1
Wend
While c > 0
g = 2 * c
d = 0
b = c
While b > 0
d = d + f(b) * a
g = g - 1
f(b) = d Mod g
d = Int(d / g)
g = g - 1
b = b - 1
If b <> 0 Then d = d * b
Wend
c = c - 14
ch = CStr(e + Int(d / a))
If Len(ch) = 1 Then ch = "0" & "0" & "0" & ch
If Len(ch) = 2 Then ch = "0" & "0" & ch
If Len(ch) = 3 Then ch = "0" & ch
rep = rep & ch
e = d Mod a
Wend
MsgBox Mid(rep, 2, 1000), 64, "Pi = " & Left(rep, 1) & ","
MsgBox Mid(rep, 1002, 1000), 64, "Suite"
MsgBox Mid(rep, 2002, 400), 64, "Suite"
End Sub
Et si quiconque s'avise de me demander à quoi ça peut bien servir
de connaître les 2399 premières décimales de pi, je répondrai ceci :
Un grand mathématicien français ( Jean Dieudonné )
affirmait que 90% des progrès réalisés en mathématique
sont dus au simple plaisir de faire des mathématiques.
Et assez curieusement, ces recherches incessantes
sur les décimales de Pi ont fait avancer diverses
branches des mathématiques.
Au début, tout semble anodin et puis tout à coup
on se rend compte que ces délires peuvent servir
à quelque chose.
Celui qu'on qualifiait de plus grand physicien du monde
dans les années 70 ( Richard Feynman) n'en revenait pas
qu'il puisse expliquer le comportement
des particules élémentaires grâce à des théories
mathématiques datant du 19 ième siècle; comme
celle d'Évariste Galois, par exemple; un autre français.
Quant à moi, toutes les occasions sont belles pour
faire des maths et progresser en VBA.
Et pour terminer mon envolée, voici un extrait du
volume " Le fascinant nombre Pi " :
« On l'aura compris, le nombre Pi n'était qu'un prétexte
pour parler de toutes les mathématiques: de la géométrie,
de l'analyse, de l'arithmétique, de l'algèbre, de la logique,
de la calculabilité, des algorithmes, des ordinateurs et bien sûr
des hommes qui, errant dans ce monde abstrait et parfois
terriblement concret, ne savent jamais s'ils ne font
que le découvrir ou s'ils le construisent. »
Une autre ?
Voici l'algorithme étonnant de Tamura et Kanada
qui a permis à ces deux lascars d'obtenir 16 millions
de décimales de Pi dans les années 80.
Il possède la surprenante propriété que le
nombre de décimales correctes double
pratiquement à chaque passage dans la boucle,
de sorte que 19 passages suffisent pour trouver
Pi avec plus d'un million de décimales !!!
J'essaie de retrouver le truc pour faire afficher
plus de 14 décimales par Excel.
Quelqu'un veut-il se joindre à moi ?
Sub Pi()
Dim A, X, B, C, Y As Double
Dim i As Integer
A = 1: X = 1: B = 1 / Sqr(2): C = 1 / 4
For i = 1 To 3
Y = A
A = (A + B) / 2
B = Sqr(B * Y)
C = C - X * (A - Y) ^ 2
X = 2 * X
Next i
MsgBox "Excel : " & WorksheetFunction.Pi & vbLf _
& "Tamura et Kanada : " & (A + B) ^ 2 / (4 * C), 64, _
"Calcul de Pi"
End Sub
'Les 2 399 premières décimales de Pi
Dim a, b, c, d, e, g As Long
Dim f(8401) As Long
Dim rep As String
Dim ch As String
rep = ""
a = 10000
c = 8400
While b <> c
f(b) = Int(a / 5)
b = b + 1
Wend
While c > 0
g = 2 * c
d = 0
b = c
While b > 0
d = d + f(b) * a
g = g - 1
f(b) = d Mod g
d = Int(d / g)
g = g - 1
b = b - 1
If b <> 0 Then d = d * b
Wend
c = c - 14
ch = CStr(e + Int(d / a))
If Len(ch) = 1 Then ch = "0" & "0" & "0" & ch
If Len(ch) = 2 Then ch = "0" & "0" & ch
If Len(ch) = 3 Then ch = "0" & ch
rep = rep & ch
e = d Mod a
Wend
MsgBox Mid(rep, 2, 1000), 64, "Pi = " & Left(rep, 1) & ","
MsgBox Mid(rep, 1002, 1000), 64, "Suite"
MsgBox Mid(rep, 2002, 400), 64, "Suite"
End Sub
Et si quiconque s'avise de me demander à quoi ça peut bien servir
de connaître les 2399 premières décimales de pi, je répondrai ceci :
Un grand mathématicien français ( Jean Dieudonné )
affirmait que 90% des progrès réalisés en mathématique
sont dus au simple plaisir de faire des mathématiques.
Et assez curieusement, ces recherches incessantes
sur les décimales de Pi ont fait avancer diverses
branches des mathématiques.
Au début, tout semble anodin et puis tout à coup
on se rend compte que ces délires peuvent servir
à quelque chose.
Celui qu'on qualifiait de plus grand physicien du monde
dans les années 70 ( Richard Feynman) n'en revenait pas
qu'il puisse expliquer le comportement
des particules élémentaires grâce à des théories
mathématiques datant du 19 ième siècle; comme
celle d'Évariste Galois, par exemple; un autre français.
Quant à moi, toutes les occasions sont belles pour
faire des maths et progresser en VBA.
Et pour terminer mon envolée, voici un extrait du
volume " Le fascinant nombre Pi " :
« On l'aura compris, le nombre Pi n'était qu'un prétexte
pour parler de toutes les mathématiques: de la géométrie,
de l'analyse, de l'arithmétique, de l'algèbre, de la logique,
de la calculabilité, des algorithmes, des ordinateurs et bien sûr
des hommes qui, errant dans ce monde abstrait et parfois
terriblement concret, ne savent jamais s'ils ne font
que le découvrir ou s'ils le construisent. »
Une autre ?
Voici l'algorithme étonnant de Tamura et Kanada
qui a permis à ces deux lascars d'obtenir 16 millions
de décimales de Pi dans les années 80.
Il possède la surprenante propriété que le
nombre de décimales correctes double
pratiquement à chaque passage dans la boucle,
de sorte que 19 passages suffisent pour trouver
Pi avec plus d'un million de décimales !!!
J'essaie de retrouver le truc pour faire afficher
plus de 14 décimales par Excel.
Quelqu'un veut-il se joindre à moi ?
Sub Pi()
Dim A, X, B, C, Y As Double
Dim i As Integer
A = 1: X = 1: B = 1 / Sqr(2): C = 1 / 4
For i = 1 To 3
Y = A
A = (A + B) / 2
B = Sqr(B * Y)
C = C - X * (A - Y) ^ 2
X = 2 * X
Next i
MsgBox "Excel : " & WorksheetFunction.Pi & vbLf _
& "Tamura et Kanada : " & (A + B) ^ 2 / (4 * C), 64, _
"Calcul de Pi"
End Sub
Serge Garneau, (N°98)
J'ai besoin de découper des tronçons de barre dans une plus grande barre. Comment optimiser mes
découpes ?
Jean Duprat te propose avec ce classeur
à télécharger de poser précisement ton problème
et de tester les différentes solutions possibles.
Très didactique...
Cette astuce est illustrée dans ce classeur exemple :
jd-decoupe (téléchargé 4937 fois)
à télécharger de poser précisement ton problème
et de tester les différentes solutions possibles.
Très didactique...
Cette astuce est illustrée dans ce classeur exemple :jd-decoupe (téléchargé 4937 fois)
Jean Duprat, (N°97)
Comment peut-on faire parler les MS-agents ?
Les MS agents", c'est une technologie de Microsoft qui semble faire suite au
compagnon
d'Office.
Il s'agit de petit personnages que le programmeur peut animer et faire parler.
Comme c'est basé
sur la technologie ActiveX, ils peuvent être manipulés aussi bien par VB - VBA
que VBScript,
C++ etc.
Tu peux aller voir la page d'acceuil:
http://www.microsoft.com/msagent/
Ou voir une démonstration par là:
http://www.microsoft.com/msagent/TryMSAgent.htm
Cette astuce est illustrée dans ce classeur exemple :
cm-merlin (téléchargé 4993 fois)
compagnon
d'Office.
Il s'agit de petit personnages que le programmeur peut animer et faire parler.
Comme c'est basé
sur la technologie ActiveX, ils peuvent être manipulés aussi bien par VB - VBA
que VBScript,
C++ etc.
Tu peux aller voir la page d'acceuil:
http://www.microsoft.com/msagent/
Ou voir une démonstration par là:
http://www.microsoft.com/msagent/TryMSAgent.htm
Cette astuce est illustrée dans ce classeur exemple :cm-merlin (téléchargé 4993 fois)
Clément Marcotte, (N°96)
Je voudrais indexer tous les mots de plus de 4 lettres contenus dans un classeur
Un classeur tout prêt de Robert
Dezan, paramétrable sur la longueur des
mots. Mode d'emploi détaillé inclus.
Cette astuce est illustrée dans ce classeur exemple :
rd-indexation (téléchargé 4874 fois)
Dezan, paramétrable sur la longueur des
mots. Mode d'emploi détaillé inclus.
Cette astuce est illustrée dans ce classeur exemple :rd-indexation (téléchargé 4874 fois)
Robert Dezan, (N°95)
Un best of d'astuces ?
Un super classeur à télécharger avec des exemples documentés et expliqués.
Près de 50 feuilles de trucs sur les dates, les formats, les fréquences, les
classements,
les somme.si, les calculs dans des pages comportant des messages d'erreur,
les sons... UNE MINE DE TRUCS !
Vive GeeDee d'Aniche !!!
Cette astuce est illustrée dans ce classeur exemple :
gd-trucs (téléchargé 13068 fois)
Près de 50 feuilles de trucs sur les dates, les formats, les fréquences, les
classements,
les somme.si, les calculs dans des pages comportant des messages d'erreur,
les sons... UNE MINE DE TRUCS !
Vive GeeDee d'Aniche !!!
Cette astuce est illustrée dans ce classeur exemple :gd-trucs (téléchargé 13068 fois)
GeeDee, (N°94)
Peut on utiliser excel comme synthé ?
Excel est un grand musicien !
colle ceci dans un module standard pour t'en convaincre :
Private Declare Function midiOutClose Lib "winmm.dll" _
(ByVal hMidiOut As Long) As Long
Private Declare Function midiOutOpen Lib "winmm.dll" _
(lphMidiOut As Long, _
ByVal uDeviceID As Long, _
ByVal dwCallback As Long, _
ByVal dwInstance As Long, _
ByVal dwFlags As Long) As Long
Private Declare Function midiOutShortMsg Lib "winmm.dll" _
(ByVal hMidiOut As Long, _
ByVal dwMsg As Long) As Long
Declare Sub Sleep Lib "Kernel32" (ByVal dwMilliseconds As Long)
Dim hMidiOut As Long
Public lanote As Integer
Public Const durée As Integer = 250 ' millisecondes'
Sub Au_clair_de_la_lune()
numéro = 0
notes_a_jouer = Array(51, 51, 51, 53, 55, 53, 51, 55, 53, 53, 51, _
51, 51, 51, 53, 55, 53, 51, 55, 53, 53, 51, _
53, 53, 53, 53, 48, 48, 53, 51, 50, 48, 46, _
51, 51, 51, 53, 55, 53, 51, 55, 53, 53, 51)
For Each noteG In notes_a_jouer
numéro = numéro + 1
dur_n = Array(300, 300, 300, 300, 600, 600, 300, 300, 300, 300, 600, _
300, 300, 300, 300, 600, 600, 300, 300, 300, 300, 600, _
300, 300, 300, 300, 600, 600, 300, 300, 300, 300, 600, _
300, 300, 300, 300, 600, 600, 300, 300, 300, 300, 600)
Temps = dur_n(numéro - 1)
On Error GoTo fin
midiOutClose hMidiOut '------------- ferme le port midi pour arreter la note précédente
midiOutOpen hMidiOut, 0, 0, 0, 0 ' ----------------ouvre le port pour la nouvelle note
midiOutShortMsg hMidiOut, RGB(192, 54 - 1, 127) 'ici, le nombre 51 peut être changé
'par un nombre de 1 à 128
lanote = 12 + CInt(noteG) ' -----on calcule la note / l'octave
note = RGB(144, lanote, 127) '-----------------------astuce pour generer un entier long
midiOutShortMsg hMidiOut, note ' --------------------on envoie la note sur le port MIDI
Sleep (Temps)
fin:
midiOutClose hMidiOut
Next
End Sub
Une autre ?
Private Declare Function midiOutClose Lib "winmm.dll" _
(ByVal hMidiOut As Long) As Long
Private Declare Function midiOutOpen Lib "winmm.dll" _
(lphMidiOut As Long, _
ByVal uDeviceID As Long, _
ByVal dwCallback As Long, _
ByVal dwInstance As Long, _
ByVal dwFlags As Long) As Long
Private Declare Function midiOutShortMsg Lib "winmm.dll" _
(ByVal hMidiOut As Long, _
ByVal dwMsg As Long) As Long
Declare Sub Sleep Lib "Kernel32" (ByVal dwMilliseconds As Long)
Dim hMidiOut As Long
Public lanote As Integer
Public Const durée As Integer = 250 ' millisecondes'
Sub joyeux_anniversaire()
Numéro = 0
notes_a_jouer = Array(50, 50, 52, 50, 55, 54, 50, _
50, 52, 50, 57, 55, 50, 50, _
62, 59, 55, 54, 52, 60, 60, 59, 55, 57, 55)
For Each noteG In notes_a_jouer
Numéro = Numéro + 1
dur_n = Array(400, 250, 700, 600, 650, 800, 400, _
250, 700, 600, 650, 800, 600, 400, 800, _
600, 600, 800, 600, 400, 300, 600, 600, 600, 2000)
Temps = dur_n(Numéro - 1)
On Error Resume Next
midiOutClose hMidiOut '------------- ferme le port midi pour arreter la
note précédente
midiOutOpen hMidiOut, 0, 0, 0, 0 ' ----------------ouvre le port pour
la nouvelle note
midiOutShortMsg hMidiOut, RGB(192, 57 - 1, 127) 'ici, le nombre 51 peut
être changé
'par un nombre de 1 à 128
lanote = 12 + CInt(noteG) ' -----on calcule la note / l'octave
note = RGB(144, lanote, 127) '-----------------------astuce pour generer
un entier long
midiOutShortMsg hMidiOut, note ' --------------------on envoie la note
sur le port MIDI
Sleep (Temps)
midiOutClose hMidiOut
Next
End Sub
Une recherche dans google usenet avec sitting hoax
comme auteur te permettra de trouver bien d'autres mélodies !
Cette astuce est illustrée dans ces classeurs exemples :
gd-instruments (téléchargé 4986 fois)
ld-chansonbebe (téléchargé 3665 fois)
ld-lalanimo (téléchargé 4229 fois)
colle ceci dans un module standard pour t'en convaincre :
Private Declare Function midiOutClose Lib "winmm.dll" _
(ByVal hMidiOut As Long) As Long
Private Declare Function midiOutOpen Lib "winmm.dll" _
(lphMidiOut As Long, _
ByVal uDeviceID As Long, _
ByVal dwCallback As Long, _
ByVal dwInstance As Long, _
ByVal dwFlags As Long) As Long
Private Declare Function midiOutShortMsg Lib "winmm.dll" _
(ByVal hMidiOut As Long, _
ByVal dwMsg As Long) As Long
Declare Sub Sleep Lib "Kernel32" (ByVal dwMilliseconds As Long)
Dim hMidiOut As Long
Public lanote As Integer
Public Const durée As Integer = 250 ' millisecondes'
Sub Au_clair_de_la_lune()
numéro = 0
notes_a_jouer = Array(51, 51, 51, 53, 55, 53, 51, 55, 53, 53, 51, _
51, 51, 51, 53, 55, 53, 51, 55, 53, 53, 51, _
53, 53, 53, 53, 48, 48, 53, 51, 50, 48, 46, _
51, 51, 51, 53, 55, 53, 51, 55, 53, 53, 51)
For Each noteG In notes_a_jouer
numéro = numéro + 1
dur_n = Array(300, 300, 300, 300, 600, 600, 300, 300, 300, 300, 600, _
300, 300, 300, 300, 600, 600, 300, 300, 300, 300, 600, _
300, 300, 300, 300, 600, 600, 300, 300, 300, 300, 600, _
300, 300, 300, 300, 600, 600, 300, 300, 300, 300, 600)
Temps = dur_n(numéro - 1)
On Error GoTo fin
midiOutClose hMidiOut '------------- ferme le port midi pour arreter la note précédente
midiOutOpen hMidiOut, 0, 0, 0, 0 ' ----------------ouvre le port pour la nouvelle note
midiOutShortMsg hMidiOut, RGB(192, 54 - 1, 127) 'ici, le nombre 51 peut être changé
'par un nombre de 1 à 128
lanote = 12 + CInt(noteG) ' -----on calcule la note / l'octave
note = RGB(144, lanote, 127) '-----------------------astuce pour generer un entier long
midiOutShortMsg hMidiOut, note ' --------------------on envoie la note sur le port MIDI
Sleep (Temps)
fin:
midiOutClose hMidiOut
Next
End Sub
Une autre ?
Private Declare Function midiOutClose Lib "winmm.dll" _
(ByVal hMidiOut As Long) As Long
Private Declare Function midiOutOpen Lib "winmm.dll" _
(lphMidiOut As Long, _
ByVal uDeviceID As Long, _
ByVal dwCallback As Long, _
ByVal dwInstance As Long, _
ByVal dwFlags As Long) As Long
Private Declare Function midiOutShortMsg Lib "winmm.dll" _
(ByVal hMidiOut As Long, _
ByVal dwMsg As Long) As Long
Declare Sub Sleep Lib "Kernel32" (ByVal dwMilliseconds As Long)
Dim hMidiOut As Long
Public lanote As Integer
Public Const durée As Integer = 250 ' millisecondes'
Sub joyeux_anniversaire()
Numéro = 0
notes_a_jouer = Array(50, 50, 52, 50, 55, 54, 50, _
50, 52, 50, 57, 55, 50, 50, _
62, 59, 55, 54, 52, 60, 60, 59, 55, 57, 55)
For Each noteG In notes_a_jouer
Numéro = Numéro + 1
dur_n = Array(400, 250, 700, 600, 650, 800, 400, _
250, 700, 600, 650, 800, 600, 400, 800, _
600, 600, 800, 600, 400, 300, 600, 600, 600, 2000)
Temps = dur_n(Numéro - 1)
On Error Resume Next
midiOutClose hMidiOut '------------- ferme le port midi pour arreter la
note précédente
midiOutOpen hMidiOut, 0, 0, 0, 0 ' ----------------ouvre le port pour
la nouvelle note
midiOutShortMsg hMidiOut, RGB(192, 57 - 1, 127) 'ici, le nombre 51 peut
être changé
'par un nombre de 1 à 128
lanote = 12 + CInt(noteG) ' -----on calcule la note / l'octave
note = RGB(144, lanote, 127) '-----------------------astuce pour generer
un entier long
midiOutShortMsg hMidiOut, note ' --------------------on envoie la note
sur le port MIDI
Sleep (Temps)
midiOutClose hMidiOut
Next
End Sub
Une recherche dans google usenet avec sitting hoax
comme auteur te permettra de trouver bien d'autres mélodies !
Cette astuce est illustrée dans ces classeurs exemples :gd-instruments (téléchargé 4986 fois)
ld-chansonbebe (téléchargé 3665 fois)
ld-lalanimo (téléchargé 4229 fois)
Laurent Daures, GeeDee, (N°93)