Re: ===> ONLY FOR THE VALENTINES GIRLS OF XLD !!!!
Bonjour André, Fabrice, Cathy et Vériland...
C'est une bonne moyenne 3 hommes pour une fille sur un Fil Spécial Filles !! (lol)
Pour André, je suis très touché par ton compliment
Pour Fabrice, Non le fichier n'est pas gourmand en ressource système, c'est tout à fait volontairement que "ça ramme"...
Pour Cathy, tu es chanceuse car tu as été "nominée et fleurie" plusieurs fois et je te souhaite un bon week end plein de bonne humeur.
Pour Vériland, tout dépend des machines, et en fait hier soir pendant que je créais ce truc, j'ai même embêté Ti et @Christophe@ pour voir comment tournaient ces boucles car sur my home bécane (PIII 800) c'est carrément une heure lol !!! (j'ai un problème sérieux avec ce PC d'ailleurs)... Sinon aujourd'hui sur différentes bécanes (du PII 400 au PIV 1800) celà varie de 2 à 7 secondes par filles.
Mais attentions quelque soit la bécane il y a y une différence de quantité de fleurs par filles avec le Step de cette ligne :
For Valentins = 1 To 7 Step Valentitine.Offset(0, 1).Value
et par conséquent tu ne peux avoir la même durée par fille.
Pour ceux qui aiment jouer avec les images sur Excel, il y a une astuce d'enfer dans ce fichier.... Hélas il aurait fallu 6 images..... Mais Too Big for Here !!! (Sniff...çà faisait une "Explosion de fleurs")
Vous pouvez le faire sans grosse modif en mettant 6 images (NB à la taille des cellules) et en les plaçant dans les cellules nommées Rose1, Rose2, Rose3, Rose4, Rose6 et Rose6... en feuille "Valentines"...
Ensuite il faut modifier juste le code comme suit :
For Vase = 1 To 6 'au lieu de 1 to 1
Amour.Shapes(Valentins).Select
Selection.Formula = "Rose" & Vase
....
Sinon j'ai été surpris que personne ne fasse de commentairess sur le Code lui même... Pour ceux / Celles qui ne l'auraient pas vu... Le voici... (au bout d'un moment je ne savais plus où j'en étais avec toutes ces Valentines et ces Valentins !!!! (lol)
Option Explicit
'Happy St Valentin par Thierry pour les "FiFilles" d'XLD, 14 Février 2003
Dim Amour As Worksheet
Sub Valentinage()
Dim MonValentin As Integer
Dim MaValentine As Range
Dim Valentins As Integer
Dim MesValentines As Range
Dim Valentitine As Range
Dim Bouquets As Range
Dim Bouquet As Range
Dim Rose As Range
Dim Vase As Byte
Dim Cadre As Range
Dim Kisses As Range
Dim Bizzzz As Range
Set MaValentine = Sheets("StValentin").Range("Valentine")
Set MesValentines = Sheets("Valentines").Range("LesValentines")
Set Bouquets = Sheets("Valentines").Range("Fleurs")
Set Bouquet = Sheets("StValentin").Range("Coeur")
Set Amour = Worksheets("StValentin")
Set Cadre = Sheets("StValentin").Range("Cadre4")
Set Kisses = Sheets("StValentin").Range("Kiss")
Set Bizzzz = Sheets("StValentin").Range("Bizz")
For Each Valentitine In MesValentines
MaValentine.Value = Valentitine.Value
'For Each Rose In Bouquets
For Valentins = 1 To 7 Step Valentitine.Offset(0, 1).Value
With MaValentine
.Interior.ColorIndex = 29
.Font.ColorIndex = 6
End With
With Cadre
.Interior.ColorIndex = 7
End With
For Vase = 1 To 1
Amour.Shapes(Valentins).Select
Selection.Formula = "Rose" & Vase
' For MonValentin = 2 To 5
' Sheets(2).Range("A" & MonValentin).Value = "Love"
With Kisses
.Interior.ColorIndex = 3
End With
With MaValentine
.Interior.ColorIndex = 29
.Font.ColorIndex = 6
End With
With Bizzzz
.Interior.ColorIndex = xlNone
End With
' Next MonValentin
With MaValentine
.Interior.ColorIndex = 7
.Font.ColorIndex = 2
End With
With Cadre
.Interior.ColorIndex = 29
End With
Next Vase
Next Valentins
With Bizzzz
.Interior.ColorIndex = 7
End With
'Next Rose
Break
Next Valentitine
End Sub
Rien que ce truc, c'est du boulot pour ne pas perdre le fil de qui est qui entre mes variables et mes objets !!! Mais c'était pour la bonne cause...
Allez Happy St Valentin
@+Thierry
