[HS] Joyeux Noël

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

et Excel leur en affecte automatiquement 1 Orval , etc).
Tout cela dans une boucle infernale !

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

Pas pour rien qu'on a mal aux cheveux ....

et Excel leur en affecte automatiquement 1 Orval , etc).
Tout cela dans une boucle infernale !

Bis repetita placent .