Sub ChangerGraine(Optional ByVal Cible = "!Graine")
Static DernH As Double: Dim H As Double
Rem. Change la graine utilisée pour les tirages aléatoire.
' Argument Cible facultatif. Si omis, "!Graine" est assumé. 2 cas :
' 1) — Un String indiquant le nom de la graine. S'il commence par un point d'exclamation,
' la suite indique un nom dans la feuille active, sinon le tout est un nom dans le classeur
' Ce nom peut avoir comme référence une cellule contenant la graine ou directement sa valeur.
' Si le nom n'existe pas, il est créé comme ayant pour référence la valeur.
' 2) — Un Range représentant la cellule devant contenir la graine
' Remarque: Pour afficher cette graine, le format de cellule "jjjj hh:mm:ss" est assez pertinent,
' parce que la graine sera l'heure courante au jour de la semaine seulement. Now aurait en effet
' trop de bits significatifs pour pouvoir être considérée à la seconde près en le type de donnée
' Single utilisé par la procédure Randomize et renvoyé par la fonction Rnd.
H = Date Mod 7 + Time: If H = 0 Then H = 7
If H = DernH Then H = H + 2 ^ -19
DernH = H
If TypeOf Cible Is Range Then Cible.Value = H: Exit Sub
If VarType(Cible) <> vbString Then MsgBox "Argument de type """ & TypeName(Cible) & """ incorrect.", _
"Spécifiez une cellule ou un nom pour la feuille ou le classeur.", _
vbCritical, "ChangerGraine": Exit Sub
On Error Resume Next
If Left$(Cible, 1) = "!" Then
If TypeOf ActiveSheet.Evaluate(Mid$(Cible, 2)) Is Range Then
ActiveSheet.Evaluate(Mid$(Cible, 2)).Value = H
Else
ActiveSheet.Names.Add Mid$(Cible, 2), H
If Err Then MsgBox "Err " & Err.Number & " lors de :" _
& vbLf & "ActiveSheet.Names.Add """ & Mid$(Cible, 2) & """, " & H _
& vbLf & Err.Description, vbExclamation, "ChangerGraine"
End If
Else
If TypeOf Application.Evaluate(Cible) Is Range Then
Application.Evaluate(Cible).Value = H
Else
ActiveWorkbook.Names.Add Cible, H
If Err Then MsgBox "Err " & Err.Number & " lors de :" _
& vbLf & "ActiveWorkbook.Names.Add """ & Cible & """, " & H _
& vbLf & Err.Description, vbExclamation, "ChangerGraine"
End If
End If
End Sub
