TELECHARGEMENT

LA MACHINE A LIRE LES PENSEES de Serge Garneau
petitemagie.zip 24 ko

A l'occasion du premier anniversaire de la FAQ le 13 septembre 2001
Robert et Serge se sont amusés à écrire une macro :o))

De Robert Dezan "BON ET HEUREUX ANNIVERSAIRE"
Les lettres changent de couleur

Sub Anniversaire()
Application.EnableCancelKey = xlErrorHandler
Application.ScreenUpdating = False

z = 2
Range(Cells(z, 2), Cells(z + 1, 2)).Select
Selection.ClearContents
Selection.Font.Name = "Comic Sans MS"
Selection.Font.Size = 36
Selection.Font.Bold = True
Txt_1 = "BON ET HEUREUX ANNIVERSAIRE"
Txt_2 = "M.P.F.E"

Range("B2").Value = Txt_1
Range("B3").Value = Txt_2

ActiveWindow.DisplayGridlines = False
Columns("B:B").EntireColumn.AutoFit
Range("B3").HorizontalAlignment = xlCenter
Range("A1").Select

Application.ScreenUpdating = True

For i = 1 To 10
For k = 1 To 2
Txt = Cells(z - 1 + k, 2).Value
For n = 1 To Len(Txt)
Cells(z - 1 + k, 2).Characters(n, 1).Font.ColorIndex = 2 + Int(8 * Rnd) + 1
Next n
Next k

DoEvents
newHour = Hour(Now())
newMinute = Minute(Now())
newSecond = Second(Now()) + 1
waitTime = TimeSerial(newHour, newMinute, newSecond)
Application.Wait waitTime
Next i
End Sub

De Serge Garneau "BON ANNIVERSAIRE MPFE"
Effet de texte

Sub Serge()
On Error Resume Next
Cancel = True
ActiveWindow.DisplayGridlines = False

ActiveSheet.DrawingObjects.Select
Selection.Delete

ActiveSheet.Shapes.AddTextEffect(msoTextEffect20, "Bon anniversaire", _
"Times New Roman", 70#, msoFalse, msoFalse, 45, 20).Select
Selection.Placement = xlFreeFloating
un = Selection.Name
ActiveSheet.Shapes.AddTextEffect(msoTextEffect16, "M.P.F.E", "Comic Sans MS", _
30#, msoFalse, msoFalse, 230, 170).Select
Selection.Placement = xlFreeFloating
deux = Selection.Name
ActiveSheet.Shapes(un).Select
m = 1

For i = 1 To 5
Selection.ShapeRange.TextEffect.Tracking = m
m = m + 0.1
DoEvents
Next i

For i = 5 To 1 Step -1
Selection.ShapeRange.TextEffect.Tracking = m
m = m - 0.1
DoEvents
Next i

Selection.ShapeRange.TextEffect.Tracking = 1
For k = 1 To 2
For i = 0 To 1 Step 0.1
[A200].Value = i
Calculate

Next i
[A300].Value = 1
For j = 1 To 0 Step -0.1
[A200].Value = j
Calculate

Next j
Next k

ActiveSheet.Shapes(deux).Select

For i = 1 To 12
Selection.ShapeRange.IncrementRotation 30
DoEvents
Next i

ActiveSheet.Shapes.AddTextEffect(msoTextEffect23, "Les joyeux lurons !", _
"Arial Black", 28#, msoFalse, msoFalse, 140, 240).Select
Selection.Placement = xlFreeFloating
[A1].Select
End Sub

[top]