[HS] Joyeux Noël

Merci Nicolas pour tes voeux et la surprise ;o))
Bonnes fêtes à toi aussi.
--
Amicales Salutations
A_S_rauphil@wanadoo.fr
Retirer A_S_ pour répondre.
XL97 / XL2002

"Nicolas B." <nicolas.bruot@adresse.bidon.com> a écrit dans le message de
news:%237kEUJgyDHA.2568@TK2MSFTNGP09.phx.gbl...

Je souhaite à tous de passer un agréable Noël, et je vous remercie tous
- pour l'aide que certains fournissent bénévolement tout au long de l'année,
- pour les HS distrayants,
- pour les questions (c'est toujours un plaisir d'y répondre),
- et pour l'ambiance générale qu'on ne retrouve pas sur les autres forums.

Voici une petite macro surprise pour patienter jusqu'aux cadeaux demain
matin :

Sub Surprise()
Randomize
X = 30
Y = 350
With ActiveSheet.Shapes.BuildFreeform(msoEditingAuto, 30, 350)
For E = 1 To 5
X = 32 + X
Y = Y - 65
.AddNodes msoSegmentLine, msoEditingAuto, X, Y
If E <> 5 Then
X = X - 15
.AddNodes msoSegmentLine, msoEditingAuto, X, Y
End If
ActiveSheet.Shapes.AddShape(msoShapeOval, X - 6.5, Y - 6.5, _
13, 13).Fill.ForeColor.SchemeColor = Int(6 * Rnd) + 2
Next
For E = 1 To 5
X = 32 + X
Y = Y + 65
.AddNodes msoSegmentLine, msoEditingAuto, X, Y
If E <> 5 Then
ActiveSheet.Shapes.AddShape(msoShapeOval, X - 6.5, Y - 6.5, _
13, 13).Fill.ForeColor.SchemeColor = Int(6 * Rnd) + 2
End If
X = X - 15
.AddNodes msoSegmentLine, msoEditingAuto, X, Y
Next
.AddNodes msoSegmentLine, msoEditingAuto, 30, 350
.ConvertToShape.Select
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 17
Selection.ShapeRange.ZOrder msoSendToBack
End With
ActiveSheet.Shapes.AddLabel(msoTextOrientationHorizontal, _
71, 232, 0, 0).Select
With Selection
.Characters.Text = "Joyeux Noël" & Chr(10) & _
"et bonne fin" & Chr(10) & "d'année"
.Font.Name = "Comic Sans MS"
.Font.Size = 18
.Font.Bold = True
.Font.ColorIndex = 3
.HorizontalAlignment = xlCenter
End With
ActiveWindow.DisplayGridlines = False

For N = 1 To 20
Application.Wait (Now + 1 / 86400)
For Each B In ActiveSheet.Shapes.Range(Array("Oval 1", "Oval 2", _
"Oval 3", "Oval 4", "Oval 5", "Oval 6", "Oval 7", _
"Oval 8", "Oval 9"))
B.Fill.ForeColor.SchemeColor = Int(6 * Rnd) + 2
Next
Next
[A1].Select
End Sub


--
Nicolas B.

Adresse @adresse.bidon.com invalide,
E-mail : www.cerbermail.com/?gAAILfkPsC

Bonjour à tous,
Juste quelques mots pour vous souhaiter, à tous, plein de bonne chose pour
cette prochaine année :
- du bonheur
- des macros qui fonctionnent
- du bonheur
- les plus belles formules dans votre tableur préféré
- du bonheur
sincèrement,
@+lolo

Merci,
Joyeux noël et bonne année à toi aussi.
JJ

"Nicolas B." <nicolas.bruot@adresse.bidon.com> a écrit dans le message news:
#7kEUJgyDHA.2568@TK2MSFTNGP09.phx.gbl...

Je souhaite à tous de passer un agréable Noël, et je vous remercie tous
- pour l'aide que certains fournissent bénévolement tout au long de
l'année,

- pour les HS distrayants,
- pour les questions (c'est toujours un plaisir d'y répondre),
- et pour l'ambiance générale qu'on ne retrouve pas sur les autres forums.

Voici une petite macro surprise pour patienter jusqu'aux cadeaux demain
matin :

Sub Surprise()
Randomize
X = 30
Y = 350
With ActiveSheet.Shapes.BuildFreeform(msoEditingAuto, 30, 350)
For E = 1 To 5
X = 32 + X
Y = Y - 65
.AddNodes msoSegmentLine, msoEditingAuto, X, Y
If E <> 5 Then
X = X - 15
.AddNodes msoSegmentLine, msoEditingAuto, X, Y
End If
ActiveSheet.Shapes.AddShape(msoShapeOval, X - 6.5, Y - 6.5, _
13, 13).Fill.ForeColor.SchemeColor = Int(6 * Rnd) + 2
Next
For E = 1 To 5
X = 32 + X
Y = Y + 65
.AddNodes msoSegmentLine, msoEditingAuto, X, Y
If E <> 5 Then
ActiveSheet.Shapes.AddShape(msoShapeOval, X - 6.5, Y - 6.5, _
13, 13).Fill.ForeColor.SchemeColor = Int(6 * Rnd) + 2
End If
X = X - 15
.AddNodes msoSegmentLine, msoEditingAuto, X, Y
Next
.AddNodes msoSegmentLine, msoEditingAuto, 30, 350
.ConvertToShape.Select
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 17
Selection.ShapeRange.ZOrder msoSendToBack
End With
ActiveSheet.Shapes.AddLabel(msoTextOrientationHorizontal, _
71, 232, 0, 0).Select
With Selection
.Characters.Text = "Joyeux Noël" & Chr(10) & _
"et bonne fin" & Chr(10) & "d'année"
.Font.Name = "Comic Sans MS"
.Font.Size = 18
.Font.Bold = True
.Font.ColorIndex = 3
.HorizontalAlignment = xlCenter
End With
ActiveWindow.DisplayGridlines = False

For N = 1 To 20
Application.Wait (Now + 1 / 86400)
For Each B In ActiveSheet.Shapes.Range(Array("Oval 1", "Oval 2", _
"Oval 3", "Oval 4", "Oval 5", "Oval 6", "Oval 7", _
"Oval 8", "Oval 9"))
B.Fill.ForeColor.SchemeColor = Int(6 * Rnd) + 2
Next
Next
[A1].Select
End Sub


--
Nicolas B.

Adresse @adresse.bidon.com invalide,
E-mail : www.cerbermail.com/?gAAILfkPsC

Salut,

Euhhhh, pour ce qui est des macros qui fonctionnent...
Faut quand même pas trop en demander ;-)


A+
--
Nicolas B.

Adresse @adresse.bidon.com invalide,
E-mail : www.cerbermail.com/?gAAILfkPsC

Bonjour à tous,
Juste quelques mots pour vous souhaiter, à tous, plein de bonne chose
pour cette prochaine année :
- du bonheur
- des macros qui fonctionnent
- du bonheur
- les plus belles formules dans votre tableur préféré
- du bonheur
sincèrement,
@+lolo

ben, l'est ben zoli ton sapin, nicolas et ton message (dont le second point me
conforte quelque peu) encore plus....
puisse le forum excel être longtemps encore ce hâvre de convivialité car je dois
dire qu'ailleurs (et je ne parle pas seulement des autres forums), c'est plutôt
du genre "marche funèbre", une marche limitée à 8 km/h afin que ceux qui courent
soient pris par les radars pétainistes de sarkozy (je dis "pétainiste" car il
suffit de lire le texte du document que le contrevenant reçoit pour se rendre
compte que le gouvernement, d'une part vous pousse à la délation dès l'instant
où vous n'étiez pas au volant du véhicule pris en faute et d'autre part, exige
que vous payiez l'amende alors que vous n'êtes pas coupable, ce qui est une
belle entorse au principe même de la justice et du droit)
jps

"Nicolas B." wrote:

Je souhaite à tous de passer un agréable Noël, et je vous remercie tous
- pour l'aide que certains fournissent bénévolement tout au long de l'année,
- pour les HS distrayants,
- pour les questions (c'est toujours un plaisir d'y répondre),
- et pour l'ambiance générale qu'on ne retrouve pas sur les autres forums.

Voici une petite macro surprise pour patienter jusqu'aux cadeaux demain
matin :

Sub Surprise()
Randomize
X = 30
Y = 350
With ActiveSheet.Shapes.BuildFreeform(msoEditingAuto, 30, 350)
For E = 1 To 5
X = 32 + X
Y = Y - 65
.AddNodes msoSegmentLine, msoEditingAuto, X, Y
If E <> 5 Then
X = X - 15
.AddNodes msoSegmentLine, msoEditingAuto, X, Y
End If
ActiveSheet.Shapes.AddShape(msoShapeOval, X - 6.5, Y - 6.5, _
13, 13).Fill.ForeColor.SchemeColor = Int(6 * Rnd) + 2
Next
For E = 1 To 5
X = 32 + X
Y = Y + 65
.AddNodes msoSegmentLine, msoEditingAuto, X, Y
If E <> 5 Then
ActiveSheet.Shapes.AddShape(msoShapeOval, X - 6.5, Y - 6.5, _
13, 13).Fill.ForeColor.SchemeColor = Int(6 * Rnd) + 2
End If
X = X - 15
.AddNodes msoSegmentLine, msoEditingAuto, X, Y
Next
.AddNodes msoSegmentLine, msoEditingAuto, 30, 350
.ConvertToShape.Select
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 17
Selection.ShapeRange.ZOrder msoSendToBack
End With
ActiveSheet.Shapes.AddLabel(msoTextOrientationHorizontal, _
71, 232, 0, 0).Select
With Selection
.Characters.Text = "Joyeux Noël" & Chr(10) & _
"et bonne fin" & Chr(10) & "d'année"
.Font.Name = "Comic Sans MS"
.Font.Size = 18
.Font.Bold = True
.Font.ColorIndex = 3
.HorizontalAlignment = xlCenter
End With
ActiveWindow.DisplayGridlines = False

For N = 1 To 20
Application.Wait (Now + 1 / 86400)
For Each B In ActiveSheet.Shapes.Range(Array("Oval 1", "Oval 2", _
"Oval 3", "Oval 4", "Oval 5", "Oval 6", "Oval 7", _
"Oval 8", "Oval 9"))
B.Fill.ForeColor.SchemeColor = Int(6 * Rnd) + 2
Next
Next
[A1].Select
End Sub

--
Nicolas B.

Adresse @adresse.bidon.com invalide,
E-mail : www.cerbermail.com/?gAAILfkPsC

Merci Nicolas,
ajoute ça et tu auras la musique qui convient:-))
à coller dans un module ordinaire (pas de feuille)
'********************
Private Declare Function MidiOutClose Lib "winmm.dll" _
Alias "midiOutClose" (ByVal hMidiOut As Long) As Long
'-------------------------------
Private Declare Function MidiOutOpen Lib "winmm.dll" _
Alias "midiOutOpen" (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" _
Alias "midiOutShortMsg" (ByVal hMidiOut As _
Long, ByVal dwMsg As Long) As Long
'...........................................................
Declare Sub Sleep Lib "Kernel32" _
(ByVal dwMilliseconds As Long)
Sub petit_papa_noel()
On Error GoTo fin
x = InputBox("entrez un nombre de 1 à 100", " Joeux Noël à tous ", "16")
If x > 100 Then
x = 100
End If
For u = x To x + 20
notees = "4853535355535355575757" & _
"58575553535353" & _
"52504848485353535555535050505" & _
"050505253505048535353535352" & _
"535556565656565556585553515" & _
"65656565858586000"
numéro = 0
For i = 1 To Len(notees) Step 2
y = Mid(notees, i, 2)
numéro = numéro + 1
numéros_temps = "3444462244446252" & _
"2222622522226222252" & _
"25244222252252222522" & _
"635522225358"
x = Mid(numéros_temps, numéro, 1) * 100
Application.EnableCancelKey = xlErrorHandler
On Error GoTo fin
MidiOutClose hMidiOut
MidiOutOpen hMidiOut, 0, 0, 0, 0
MidiOutShortMsg hMidiOut, RGB(192, u + 10, 127)
lanote = 12 + CInt(y)
note = RGB(144, lanote, 127)
MidiOutShortMsg hMidiOut, note
Sleep (x)
MidiOutClose hMidiOut
Next
Next
fin:
MidiOutClose hMidiOut
End
End Sub
'*************
Amicalement
Sitting Hoax
"Nicolas B." <nicolas.bruot@adresse.bidon.com> a écrit dans le message de ne
ws:%237kEUJgyDHA.2568@TK2MSFTNGP09.phx.gbl...

Je souhaite à tous de passer un agréable Noël, et je vous remercie tous
- pour l'aide que certains fournissent bénévolement tout au long de
l'année,

- pour les HS distrayants,
- pour les questions (c'est toujours un plaisir d'y répondre),
- et pour l'ambiance générale qu'on ne retrouve pas sur les autres forums.

Voici une petite macro surprise pour patienter jusqu'aux cadeaux demain
matin :

Sub Surprise()
Randomize
X = 30
Y = 350
With ActiveSheet.Shapes.BuildFreeform(msoEditingAuto, 30, 350)
For E = 1 To 5
X = 32 + X
Y = Y - 65
.AddNodes msoSegmentLine, msoEditingAuto, X, Y
If E <> 5 Then
X = X - 15
.AddNodes msoSegmentLine, msoEditingAuto, X, Y
End If
ActiveSheet.Shapes.AddShape(msoShapeOval, X - 6.5, Y - 6.5, _
13, 13).Fill.ForeColor.SchemeColor = Int(6 * Rnd) + 2
Next
For E = 1 To 5
X = 32 + X
Y = Y + 65
.AddNodes msoSegmentLine, msoEditingAuto, X, Y
If E <> 5 Then
ActiveSheet.Shapes.AddShape(msoShapeOval, X - 6.5, Y - 6.5, _
13, 13).Fill.ForeColor.SchemeColor = Int(6 * Rnd) + 2
End If
X = X - 15
.AddNodes msoSegmentLine, msoEditingAuto, X, Y
Next
.AddNodes msoSegmentLine, msoEditingAuto, 30, 350
.ConvertToShape.Select
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 17
Selection.ShapeRange.ZOrder msoSendToBack
End With
ActiveSheet.Shapes.AddLabel(msoTextOrientationHorizontal, _
71, 232, 0, 0).Select
With Selection
.Characters.Text = "Joyeux Noël" & Chr(10) & _
"et bonne fin" & Chr(10) & "d'année"
.Font.Name = "Comic Sans MS"
.Font.Size = 18
.Font.Bold = True
.Font.ColorIndex = 3
.HorizontalAlignment = xlCenter
End With
ActiveWindow.DisplayGridlines = False

For N = 1 To 20
Application.Wait (Now + 1 / 86400)
For Each B In ActiveSheet.Shapes.Range(Array("Oval 1", "Oval 2", _
"Oval 3", "Oval 4", "Oval 5", "Oval 6", "Oval 7", _
"Oval 8", "Oval 9"))
B.Fill.ForeColor.SchemeColor = Int(6 * Rnd) + 2
Next
Next
[A1].Select
End Sub


--
Nicolas B.

Adresse @adresse.bidon.com invalide,
E-mail : www.cerbermail.com/?gAAILfkPsC

Merci pour l'ambiance musicale ;-)

Et pour plus d'effet, un mix des deux macros : le clignotement des boules
est synchronisé avec la musique :-)

'********************
Private Declare Function MidiOutClose Lib "winmm.dll" _
Alias "midiOutClose" (ByVal hMidiOut As Long) As Long
'-------------------------------
Private Declare Function MidiOutOpen Lib "winmm.dll" _
Alias "midiOutOpen" (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" _
Alias "midiOutShortMsg" (ByVal hMidiOut As _
Long, ByVal dwMsg As Long) As Long
'...........................................................
Declare Sub Sleep Lib "Kernel32" _
(ByVal dwMilliseconds As Long)
Sub petit_papa_noel()
Randomize
x = 30
y = 350
With ActiveSheet.Shapes.BuildFreeform(msoEditingAuto, 30, 350)
For E = 1 To 5
x = 32 + x
y = y - 65
.AddNodes msoSegmentLine, msoEditingAuto, x, y
If E <> 5 Then
x = x - 15
.AddNodes msoSegmentLine, msoEditingAuto, x, y
End If
ActiveSheet.Shapes.AddShape(msoShapeOval, x - 6.5, y - 6.5, _
13, 13).Fill.ForeColor.SchemeColor = Int(6 * Rnd) + 2
Next
For E = 1 To 5
x = 32 + x
y = y + 65
.AddNodes msoSegmentLine, msoEditingAuto, x, y
If E <> 5 Then
ActiveSheet.Shapes.AddShape(msoShapeOval, x - 6.5, y - 6.5, _
13, 13).Fill.ForeColor.SchemeColor = Int(6 * Rnd) + 2
End If
x = x - 15
.AddNodes msoSegmentLine, msoEditingAuto, x, y
Next
.AddNodes msoSegmentLine, msoEditingAuto, 30, 350
.ConvertToShape.Select
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 17
Selection.ShapeRange.ZOrder msoSendToBack
End With
ActiveSheet.Shapes.AddLabel(msoTextOrientationHorizontal, _
71, 232, 0, 0).Select
With Selection
.Characters.Text = "Joyeux Noël" & Chr(10) & _
"et bonne fin" & Chr(10) & "d'année"
.Font.Name = "Comic Sans MS"
.Font.Size = 18
.Font.Bold = True
.Font.ColorIndex = 3
.HorizontalAlignment = xlCenter
End With
ActiveWindow.DisplayGridlines = False

On Error GoTo fin
x = InputBox("entrez un nombre de 1 à 100", " Joyeux Noël à tous ", "16")
If x > 100 Then
x = 100
End If
For u = x To x + 20
notees = "4853535355535355575757" & _
"58575553535353" & _
"52504848485353535555535050505" & _
"050505253505048535353535352" & _
"535556565656565556585553515" & _
"65656565858586000"
numéro = 0
For i = 1 To Len(notees) Step 2
y = Mid(notees, i, 2)
numéro = numéro + 1
numéros_temps = "3444462244446252" & _
"2222622522226222252" & _
"25244222252252222522" & _
"635522225358"
x = Mid(numéros_temps, numéro, 1) * 100
Application.EnableCancelKey = xlErrorHandler
For Each B In ActiveSheet.Shapes.Range(Array("Oval 1", "Oval 2", _
"Oval 3", "Oval 4", "Oval 5", "Oval 6", "Oval 7", _
"Oval 8", "Oval 9"))
B.Fill.ForeColor.SchemeColor = Int(6 * Rnd) + 2
ActiveSheet.Calculate
Next
On Error GoTo fin
MidiOutClose hMidiOut
MidiOutOpen hMidiOut, 0, 0, 0, 0
MidiOutShortMsg hMidiOut, RGB(192, u + 10, 127)
lanote = 12 + CInt(y)
note = RGB(144, lanote, 127)
MidiOutShortMsg hMidiOut, note
Sleep (x)
MidiOutClose hMidiOut
Next
Next
fin:
MidiOutClose hMidiOut
End
End Sub
'*************


--
Nicolas B.

Adresse @adresse.bidon.com invalide,
E-mail : www.cerbermail.com/?gAAILfkPsC

Merci Nicolas,
ajoute ça et tu auras la musique qui convient:-))
à coller dans un module ordinaire (pas de feuille)
'********************
Private Declare Function MidiOutClose Lib "winmm.dll" _
Alias "midiOutClose" (ByVal hMidiOut As Long) As Long
'-------------------------------
Private Declare Function MidiOutOpen Lib "winmm.dll" _
Alias "midiOutOpen" (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" _
Alias "midiOutShortMsg" (ByVal hMidiOut As _
Long, ByVal dwMsg As Long) As Long
'...........................................................
Declare Sub Sleep Lib "Kernel32" _
(ByVal dwMilliseconds As Long)
Sub petit_papa_noel()
On Error GoTo fin
x = InputBox("entrez un nombre de 1 à 100", " Joeux Noël à tous ",
"16")
If x > 100 Then
x = 100
End If
For u = x To x + 20
notees = "4853535355535355575757" & _
"58575553535353" & _
"52504848485353535555535050505" & _
"050505253505048535353535352" & _
"535556565656565556585553515" & _
"65656565858586000"
numéro = 0
For i = 1 To Len(notees) Step 2
y = Mid(notees, i, 2)
numéro = numéro + 1
numéros_temps = "3444462244446252" & _
"2222622522226222252" & _
"25244222252252222522" & _
"635522225358"
x = Mid(numéros_temps, numéro, 1) * 100
Application.EnableCancelKey = xlErrorHandler
On Error GoTo fin
MidiOutClose hMidiOut
MidiOutOpen hMidiOut, 0, 0, 0, 0
MidiOutShortMsg hMidiOut, RGB(192, u + 10, 127)
lanote = 12 + CInt(y)
note = RGB(144, lanote, 127)
MidiOutShortMsg hMidiOut, note
Sleep (x)
MidiOutClose hMidiOut
Next
Next
fin:
MidiOutClose hMidiOut
End
End Sub
'*************
Amicalement
Sitting Hoax
"Nicolas B." <nicolas.bruot@adresse.bidon.com> a écrit dans le
message de ne ws:%237kEUJgyDHA.2568@TK2MSFTNGP09.phx.gbl...

Je souhaite à tous de passer un agréable Noël, et je vous remercie
tous
- pour l'aide que certains fournissent bénévolement tout au long de
l'année,
- pour les HS distrayants,
- pour les questions (c'est toujours un plaisir d'y répondre),
- et pour l'ambiance générale qu'on ne retrouve pas sur les autres
forums.

Voici une petite macro surprise pour patienter jusqu'aux cadeaux
demain matin :

Sub Surprise()
Randomize
X = 30
Y = 350
With ActiveSheet.Shapes.BuildFreeform(msoEditingAuto, 30, 350)
For E = 1 To 5
X = 32 + X
Y = Y - 65
.AddNodes msoSegmentLine, msoEditingAuto, X, Y
If E <> 5 Then
X = X - 15
.AddNodes msoSegmentLine, msoEditingAuto, X, Y
End If
ActiveSheet.Shapes.AddShape(msoShapeOval, X - 6.5, Y - 6.5, _
13, 13).Fill.ForeColor.SchemeColor = Int(6 * Rnd) + 2
Next
For E = 1 To 5
X = 32 + X
Y = Y + 65
.AddNodes msoSegmentLine, msoEditingAuto, X, Y
If E <> 5 Then
ActiveSheet.Shapes.AddShape(msoShapeOval, X - 6.5, Y - 6.5, _
13, 13).Fill.ForeColor.SchemeColor = Int(6 * Rnd) + 2
End If
X = X - 15
.AddNodes msoSegmentLine, msoEditingAuto, X, Y
Next
.AddNodes msoSegmentLine, msoEditingAuto, 30, 350
.ConvertToShape.Select
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 17
Selection.ShapeRange.ZOrder msoSendToBack
End With
ActiveSheet.Shapes.AddLabel(msoTextOrientationHorizontal, _
71, 232, 0, 0).Select
With Selection
.Characters.Text = "Joyeux Noël" & Chr(10) & _
"et bonne fin" & Chr(10) & "d'année"
.Font.Name = "Comic Sans MS"
.Font.Size = 18
.Font.Bold = True
.Font.ColorIndex = 3
.HorizontalAlignment = xlCenter
End With
ActiveWindow.DisplayGridlines = False

For N = 1 To 20
Application.Wait (Now + 1 / 86400)
For Each B In ActiveSheet.Shapes.Range(Array("Oval 1", "Oval 2", _
"Oval 3", "Oval 4", "Oval 5", "Oval 6", "Oval 7", _
"Oval 8", "Oval 9"))
B.Fill.ForeColor.SchemeColor = Int(6 * Rnd) + 2
Next
Next
[A1].Select
End Sub


--
Nicolas B.

Adresse @adresse.bidon.com invalide,
E-mail : www.cerbermail.com/?gAAILfkPsC

Salut Nicolas,

La macro bloque ici :

For Each B In ActiveSheet.Shapes.Range(Array("Oval 1", "Oval 2", _
"Oval 3", "Oval 4", "Oval 5", "Oval 6", "Oval 7", _
"Oval 8", "Oval 9"))
B.Fill.ForeColor.SchemeColor = Int(6 * Rnd) + 2
ActiveSheet.Calculate
Next

Bon réveillon,

Serge


"Nicolas B." <nicolas.bruot@adresse.bidon.com> a écrit dans le message de
news: OHFVwIlyDHA.2308@TK2MSFTNGP11.phx.gbl...

Merci pour l'ambiance musicale ;-)

Et pour plus d'effet, un mix des deux macros : le clignotement des boules
est synchronisé avec la musique :-)

'********************
Private Declare Function MidiOutClose Lib "winmm.dll" _
Alias "midiOutClose" (ByVal hMidiOut As Long) As Long
'-------------------------------
Private Declare Function MidiOutOpen Lib "winmm.dll" _
Alias "midiOutOpen" (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" _
Alias "midiOutShortMsg" (ByVal hMidiOut As _
Long, ByVal dwMsg As Long) As Long
'...........................................................
Declare Sub Sleep Lib "Kernel32" _
(ByVal dwMilliseconds As Long)
Sub petit_papa_noel()
Randomize
x = 30
y = 350
With ActiveSheet.Shapes.BuildFreeform(msoEditingAuto, 30, 350)
For E = 1 To 5
x = 32 + x
y = y - 65
.AddNodes msoSegmentLine, msoEditingAuto, x, y
If E <> 5 Then
x = x - 15
.AddNodes msoSegmentLine, msoEditingAuto, x, y
End If
ActiveSheet.Shapes.AddShape(msoShapeOval, x - 6.5, y - 6.5, _
13, 13).Fill.ForeColor.SchemeColor = Int(6 * Rnd) + 2
Next
For E = 1 To 5
x = 32 + x
y = y + 65
.AddNodes msoSegmentLine, msoEditingAuto, x, y
If E <> 5 Then
ActiveSheet.Shapes.AddShape(msoShapeOval, x - 6.5, y - 6.5, _
13, 13).Fill.ForeColor.SchemeColor = Int(6 * Rnd) + 2
End If
x = x - 15
.AddNodes msoSegmentLine, msoEditingAuto, x, y
Next
.AddNodes msoSegmentLine, msoEditingAuto, 30, 350
.ConvertToShape.Select
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 17
Selection.ShapeRange.ZOrder msoSendToBack
End With
ActiveSheet.Shapes.AddLabel(msoTextOrientationHorizontal, _
71, 232, 0, 0).Select
With Selection
.Characters.Text = "Joyeux Noël" & Chr(10) & _
"et bonne fin" & Chr(10) & "d'année"
.Font.Name = "Comic Sans MS"
.Font.Size = 18
.Font.Bold = True
.Font.ColorIndex = 3
.HorizontalAlignment = xlCenter
End With
ActiveWindow.DisplayGridlines = False

On Error GoTo fin
x = InputBox("entrez un nombre de 1 à 100", " Joyeux Noël à tous ", "16")
If x > 100 Then
x = 100
End If
For u = x To x + 20
notees = "4853535355535355575757" & _
"58575553535353" & _
"52504848485353535555535050505" & _
"050505253505048535353535352" & _
"535556565656565556585553515" & _
"65656565858586000"
numéro = 0
For i = 1 To Len(notees) Step 2
y = Mid(notees, i, 2)
numéro = numéro + 1
numéros_temps = "3444462244446252" & _
"2222622522226222252" & _
"25244222252252222522" & _
"635522225358"
x = Mid(numéros_temps, numéro, 1) * 100
Application.EnableCancelKey = xlErrorHandler
For Each B In ActiveSheet.Shapes.Range(Array("Oval 1", "Oval 2", _
"Oval 3", "Oval 4", "Oval 5", "Oval 6", "Oval 7", _
"Oval 8", "Oval 9"))
B.Fill.ForeColor.SchemeColor = Int(6 * Rnd) + 2
ActiveSheet.Calculate
Next
On Error GoTo fin
MidiOutClose hMidiOut
MidiOutOpen hMidiOut, 0, 0, 0, 0
MidiOutShortMsg hMidiOut, RGB(192, u + 10, 127)
lanote = 12 + CInt(y)
note = RGB(144, lanote, 127)
MidiOutShortMsg hMidiOut, note
Sleep (x)
MidiOutClose hMidiOut
Next
Next
fin:
MidiOutClose hMidiOut
End
End Sub
'*************


--
Nicolas B.

Adresse @adresse.bidon.com invalide,
E-mail : www.cerbermail.com/?gAAILfkPsC

Merci Nicolas,
ajoute ça et tu auras la musique qui convient:-))
à coller dans un module ordinaire (pas de feuille)
'********************
Private Declare Function MidiOutClose Lib "winmm.dll" _
Alias "midiOutClose" (ByVal hMidiOut As Long) As Long
'-------------------------------
Private Declare Function MidiOutOpen Lib "winmm.dll" _
Alias "midiOutOpen" (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" _
Alias "midiOutShortMsg" (ByVal hMidiOut As _
Long, ByVal dwMsg As Long) As Long
'...........................................................
Declare Sub Sleep Lib "Kernel32" _
(ByVal dwMilliseconds As Long)
Sub petit_papa_noel()
On Error GoTo fin
x = InputBox("entrez un nombre de 1 à 100", " Joeux Noël à tous ",
"16")
If x > 100 Then
x = 100
End If
For u = x To x + 20
notees = "4853535355535355575757" & _
"58575553535353" & _
"52504848485353535555535050505" & _
"050505253505048535353535352" & _
"535556565656565556585553515" & _
"65656565858586000"
numéro = 0
For i = 1 To Len(notees) Step 2
y = Mid(notees, i, 2)
numéro = numéro + 1
numéros_temps = "3444462244446252" & _
"2222622522226222252" & _
"25244222252252222522" & _
"635522225358"
x = Mid(numéros_temps, numéro, 1) * 100
Application.EnableCancelKey = xlErrorHandler
On Error GoTo fin
MidiOutClose hMidiOut
MidiOutOpen hMidiOut, 0, 0, 0, 0
MidiOutShortMsg hMidiOut, RGB(192, u + 10, 127)
lanote = 12 + CInt(y)
note = RGB(144, lanote, 127)
MidiOutShortMsg hMidiOut, note
Sleep (x)
MidiOutClose hMidiOut
Next
Next
fin:
MidiOutClose hMidiOut
End
End Sub
'*************
Amicalement
Sitting Hoax
"Nicolas B." <nicolas.bruot@adresse.bidon.com> a écrit dans le
message de ne ws:%237kEUJgyDHA.2568@TK2MSFTNGP09.phx.gbl...

Je souhaite à tous de passer un agréable Noël, et je vous remercie
tous
- pour l'aide que certains fournissent bénévolement tout au long de
l'année,
- pour les HS distrayants,
- pour les questions (c'est toujours un plaisir d'y répondre),
- et pour l'ambiance générale qu'on ne retrouve pas sur les autres
forums.

Voici une petite macro surprise pour patienter jusqu'aux cadeaux
demain matin :

Sub Surprise()
Randomize
X = 30
Y = 350
With ActiveSheet.Shapes.BuildFreeform(msoEditingAuto, 30, 350)
For E = 1 To 5
X = 32 + X
Y = Y - 65
.AddNodes msoSegmentLine, msoEditingAuto, X, Y
If E <> 5 Then
X = X - 15
.AddNodes msoSegmentLine, msoEditingAuto, X, Y
End If
ActiveSheet.Shapes.AddShape(msoShapeOval, X - 6.5, Y - 6.5, _
13, 13).Fill.ForeColor.SchemeColor = Int(6 * Rnd) + 2
Next
For E = 1 To 5
X = 32 + X
Y = Y + 65
.AddNodes msoSegmentLine, msoEditingAuto, X, Y
If E <> 5 Then
ActiveSheet.Shapes.AddShape(msoShapeOval, X - 6.5, Y - 6.5, _
13, 13).Fill.ForeColor.SchemeColor = Int(6 * Rnd) + 2
End If
X = X - 15
.AddNodes msoSegmentLine, msoEditingAuto, X, Y
Next
.AddNodes msoSegmentLine, msoEditingAuto, 30, 350
.ConvertToShape.Select
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 17
Selection.ShapeRange.ZOrder msoSendToBack
End With
ActiveSheet.Shapes.AddLabel(msoTextOrientationHorizontal, _
71, 232, 0, 0).Select
With Selection
.Characters.Text = "Joyeux Noël" & Chr(10) & _
"et bonne fin" & Chr(10) & "d'année"
.Font.Name = "Comic Sans MS"
.Font.Size = 18
.Font.Bold = True
.Font.ColorIndex = 3
.HorizontalAlignment = xlCenter
End With
ActiveWindow.DisplayGridlines = False

For N = 1 To 20
Application.Wait (Now + 1 / 86400)
For Each B In ActiveSheet.Shapes.Range(Array("Oval 1", "Oval 2", _
"Oval 3", "Oval 4", "Oval 5", "Oval 6", "Oval 7", _
"Oval 8", "Oval 9"))
B.Fill.ForeColor.SchemeColor = Int(6 * Rnd) + 2
Next
Next
[A1].Select
End Sub


--
Nicolas B.

Adresse @adresse.bidon.com invalide,
E-mail : www.cerbermail.com/?gAAILfkPsC

Salut garnote,

Dans le tracé du sapin, je ne donne pas de nom aux formes tracées et Excel
leur en affecte automatiquement un ("Oval 1", etc). Essaye de trouver quels
noms sont affectés aux boules (avec l'enregistreur, en sélectionnant une des
boules). En remplacant ces noms dans la macro, ça devrait fonctionner.


Joyeux Noël à toi aussi.
--
Nicolas B.

Adresse @adresse.bidon.com invalide,
E-mail : www.cerbermail.com/?gAAILfkPsC

Salut Nicolas,

La macro bloque ici :

For Each B In ActiveSheet.Shapes.Range(Array("Oval 1", "Oval 2", _
"Oval 3", "Oval 4", "Oval 5", "Oval 6", "Oval 7", _
"Oval 8", "Oval 9"))
B.Fill.ForeColor.SchemeColor = Int(6 * Rnd) + 2
ActiveSheet.Calculate
Next

Bon réveillon,

Serge


"Nicolas B." <nicolas.bruot@adresse.bidon.com> a écrit dans le
message de news: OHFVwIlyDHA.2308@TK2MSFTNGP11.phx.gbl...

Merci pour l'ambiance musicale ;-)

Et pour plus d'effet, un mix des deux macros : le clignotement des
boules est synchronisé avec la musique :-)

'********************
Private Declare Function MidiOutClose Lib "winmm.dll" _
Alias "midiOutClose" (ByVal hMidiOut As Long) As Long
'-------------------------------
Private Declare Function MidiOutOpen Lib "winmm.dll" _
Alias "midiOutOpen" (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" _
Alias "midiOutShortMsg" (ByVal hMidiOut As _
Long, ByVal dwMsg As Long) As Long
'...........................................................
Declare Sub Sleep Lib "Kernel32" _
(ByVal dwMilliseconds As Long)
Sub petit_papa_noel()
Randomize
x = 30
y = 350
With ActiveSheet.Shapes.BuildFreeform(msoEditingAuto, 30, 350)
For E = 1 To 5
x = 32 + x
y = y - 65
.AddNodes msoSegmentLine, msoEditingAuto, x, y
If E <> 5 Then
x = x - 15
.AddNodes msoSegmentLine, msoEditingAuto, x, y
End If
ActiveSheet.Shapes.AddShape(msoShapeOval, x - 6.5, y - 6.5, _
13, 13).Fill.ForeColor.SchemeColor = Int(6 * Rnd) + 2
Next
For E = 1 To 5
x = 32 + x
y = y + 65
.AddNodes msoSegmentLine, msoEditingAuto, x, y
If E <> 5 Then
ActiveSheet.Shapes.AddShape(msoShapeOval, x - 6.5, y - 6.5, _
13, 13).Fill.ForeColor.SchemeColor = Int(6 * Rnd) + 2
End If
x = x - 15
.AddNodes msoSegmentLine, msoEditingAuto, x, y
Next
.AddNodes msoSegmentLine, msoEditingAuto, 30, 350
.ConvertToShape.Select
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 17
Selection.ShapeRange.ZOrder msoSendToBack
End With
ActiveSheet.Shapes.AddLabel(msoTextOrientationHorizontal, _
71, 232, 0, 0).Select
With Selection
.Characters.Text = "Joyeux Noël" & Chr(10) & _
"et bonne fin" & Chr(10) & "d'année"
.Font.Name = "Comic Sans MS"
.Font.Size = 18
.Font.Bold = True
.Font.ColorIndex = 3
.HorizontalAlignment = xlCenter
End With
ActiveWindow.DisplayGridlines = False

On Error GoTo fin
x = InputBox("entrez un nombre de 1 à 100", " Joyeux Noël à tous ",
"16") If x > 100 Then
x = 100
End If
For u = x To x + 20
notees = "4853535355535355575757" & _
"58575553535353" & _
"52504848485353535555535050505" & _
"050505253505048535353535352" & _
"535556565656565556585553515" & _
"65656565858586000"
numéro = 0
For i = 1 To Len(notees) Step 2
y = Mid(notees, i, 2)
numéro = numéro + 1
numéros_temps = "3444462244446252" & _
"2222622522226222252" & _
"25244222252252222522" & _
"635522225358"
x = Mid(numéros_temps, numéro, 1) * 100
Application.EnableCancelKey = xlErrorHandler
For Each B In ActiveSheet.Shapes.Range(Array("Oval 1", "Oval 2", _
"Oval 3", "Oval 4", "Oval 5", "Oval 6", "Oval 7", _
"Oval 8", "Oval 9"))
B.Fill.ForeColor.SchemeColor = Int(6 * Rnd) + 2
ActiveSheet.Calculate
Next
On Error GoTo fin
MidiOutClose hMidiOut
MidiOutOpen hMidiOut, 0, 0, 0, 0
MidiOutShortMsg hMidiOut, RGB(192, u + 10, 127)
lanote = 12 + CInt(y)
note = RGB(144, lanote, 127)
MidiOutShortMsg hMidiOut, note
Sleep (x)
MidiOutClose hMidiOut
Next
Next
fin:
MidiOutClose hMidiOut
End
End Sub
'*************


--
Nicolas B.

Adresse @adresse.bidon.com invalide,
E-mail : www.cerbermail.com/?gAAILfkPsC

Merci Nicolas,
ajoute ça et tu auras la musique qui convient:-))
à coller dans un module ordinaire (pas de feuille)
'********************
Private Declare Function MidiOutClose Lib "winmm.dll" _
Alias "midiOutClose" (ByVal hMidiOut As Long) As Long
'-------------------------------
Private Declare Function MidiOutOpen Lib "winmm.dll" _
Alias "midiOutOpen" (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" _
Alias "midiOutShortMsg" (ByVal hMidiOut As _
Long, ByVal dwMsg As Long) As Long
'...........................................................
Declare Sub Sleep Lib "Kernel32" _
(ByVal dwMilliseconds As Long)
Sub petit_papa_noel()
On Error GoTo fin
x = InputBox("entrez un nombre de 1 à 100", " Joeux Noël à tous ",
"16")
If x > 100 Then
x = 100
End If
For u = x To x + 20
notees = "4853535355535355575757" & _
"58575553535353" & _
"52504848485353535555535050505" & _
"050505253505048535353535352" & _
"535556565656565556585553515" & _
"65656565858586000"
numéro = 0
For i = 1 To Len(notees) Step 2
y = Mid(notees, i, 2)
numéro = numéro + 1
numéros_temps = "3444462244446252" & _
"2222622522226222252" & _
"25244222252252222522" & _
"635522225358"
x = Mid(numéros_temps, numéro, 1) * 100
Application.EnableCancelKey = xlErrorHandler
On Error GoTo fin
MidiOutClose hMidiOut
MidiOutOpen hMidiOut, 0, 0, 0, 0
MidiOutShortMsg hMidiOut, RGB(192, u + 10, 127)
lanote = 12 + CInt(y)
note = RGB(144, lanote, 127)
MidiOutShortMsg hMidiOut, note
Sleep (x)
MidiOutClose hMidiOut
Next
Next
fin:
MidiOutClose hMidiOut
End
End Sub
'*************
Amicalement
Sitting Hoax
"Nicolas B." <nicolas.bruot@adresse.bidon.com> a écrit dans le
message de ne ws:%237kEUJgyDHA.2568@TK2MSFTNGP09.phx.gbl...

Je souhaite à tous de passer un agréable Noël, et je vous remercie
tous
- pour l'aide que certains fournissent bénévolement tout au long de
l'année,
- pour les HS distrayants,
- pour les questions (c'est toujours un plaisir d'y répondre),
- et pour l'ambiance générale qu'on ne retrouve pas sur les autres
forums.

Voici une petite macro surprise pour patienter jusqu'aux cadeaux
demain matin :

Sub Surprise()
Randomize
X = 30
Y = 350
With ActiveSheet.Shapes.BuildFreeform(msoEditingAuto, 30, 350)
For E = 1 To 5
X = 32 + X
Y = Y - 65
.AddNodes msoSegmentLine, msoEditingAuto, X, Y
If E <> 5 Then
X = X - 15
.AddNodes msoSegmentLine, msoEditingAuto, X, Y
End If
ActiveSheet.Shapes.AddShape(msoShapeOval, X - 6.5, Y - 6.5, _
13, 13).Fill.ForeColor.SchemeColor = Int(6 * Rnd) + 2
Next
For E = 1 To 5
X = 32 + X
Y = Y + 65
.AddNodes msoSegmentLine, msoEditingAuto, X, Y
If E <> 5 Then
ActiveSheet.Shapes.AddShape(msoShapeOval, X - 6.5, Y - 6.5, _
13, 13).Fill.ForeColor.SchemeColor = Int(6 * Rnd) + 2
End If
X = X - 15
.AddNodes msoSegmentLine, msoEditingAuto, X, Y
Next
.AddNodes msoSegmentLine, msoEditingAuto, 30, 350
.ConvertToShape.Select
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 17
Selection.ShapeRange.ZOrder msoSendToBack
End With
ActiveSheet.Shapes.AddLabel(msoTextOrientationHorizontal, _
71, 232, 0, 0).Select
With Selection
.Characters.Text = "Joyeux Noël" & Chr(10) & _
"et bonne fin" & Chr(10) & "d'année"
.Font.Name = "Comic Sans MS"
.Font.Size = 18
.Font.Bold = True
.Font.ColorIndex = 3
.HorizontalAlignment = xlCenter
End With
ActiveWindow.DisplayGridlines = False

For N = 1 To 20
Application.Wait (Now + 1 / 86400)
For Each B In ActiveSheet.Shapes.Range(Array("Oval 1", "Oval 2", _
"Oval 3", "Oval 4", "Oval 5", "Oval 6", "Oval 7", _
"Oval 8", "Oval 9"))
B.Fill.ForeColor.SchemeColor = Int(6 * Rnd) + 2
Next
Next
[A1].Select
End Sub


--
Nicolas B.

Adresse @adresse.bidon.com invalide,
E-mail : www.cerbermail.com/?gAAILfkPsC

Ah, au moins un qui voit clair et qui reste lucide dans cette assemblée.

--
Jacquouille conseille : http://www.excelabo.net

NoSpam_j.thiernesse@skynet.be
"Nicolas B." <nicolas.bruot@adresse.bidon.com> a écrit dans le message news:
OMPRjxgyDHA.2396@TK2MSFTNGP10.phx.gbl...

Salut,

Euhhhh, pour ce qui est des macros qui fonctionnent...
Faut quand même pas trop en demander ;-)


A+
--
Nicolas B.

Adresse @adresse.bidon.com invalide,
E-mail : www.cerbermail.com/?gAAILfkPsC

Bonjour à tous,
Juste quelques mots pour vous souhaiter, à tous, plein de bonne chose
pour cette prochaine année :
- du bonheur
- des macros qui fonctionnent
- du bonheur
- les plus belles formules dans votre tableur préféré
- du bonheur
sincèrement,
@+lolo