VBA : Tirage sans remise

Bonjour

euh ...on constatera que la fonction ci-dessous ne contient ni "remise", ni étiquette, ni rien du tout :

Function fRandomize(NbreElements As Integer) As Integer
fRandomize = -Int(-rnd * NbreElements)
End Function

mais pour le "tirage", il faut touiller un peu et...

sub Tirage()
msgbox fRandomize (150)
end sub


--
Arnaud
---------------------------------------------
infos, conseils et liens : http://www.mpfa.info
---------------------------------------------

"Patty" <patty.st@free.fr> a écrit dans le message de news: eROxOlddGHA.5116@TK2MSFTNGP04.phx.gbl...

Salut,

Quelqu'un aurait t'il une idéee pour faire un tirage sans remise parmi n éléments ?
Merci pour toute ade

Bonsoir,

Par exemple tirer 15 lettres parmi les 26 de l'alphabet.
Ce n'est pas peaufiné mais c'est un début.

' --------------------------------------------------------
' dans un module de portée globale nommé par ex modTirage:
' --------------------------------------------------------
Option Compare Database
Option Explicit
Option Base 1 'le 1er indice des tableaux est 1

Type sTirage
lettre As String
sorti As Boolean
End Type

Public Tirage() As sTirage
Public ReTirage() As sTirage
Const Nb As Integer = 26

Sub Initialisation()
' Remplissage du tableau de départ avec des lettres
ReDim Tirage(26)
Dim i As Integer
For i = 1 To Nb
Tirage(i).lettre = Chr(64 + i) ' A, B, C ...
Tirage(i).sorti = False
Next i
End Sub

Sub ReInitialisation()
' on reconstruit le tableau dans lequel on tirera
' la prochaine lettre
Dim i As Integer, j As Integer
For i = 1 To Nb
If Tirage(i).sorti = False Then
j = j + 1
ReDim Preserve ReTirage(j)
ReTirage(j).lettre = Tirage(i).lettre
ReTirage(j).sorti = False
End If
Next i
End Sub

Function fnLettre(NbLettres As Integer) As String
Dim i As Integer, j As Integer
Dim element As Integer
For j = 1 To NbLettres
ReInitialisation
Randomize Timer
element = Int(Rnd * UBound(ReTirage)) + 1
ReTirage(element).sorti = True
For i = 1 To Nb
If Tirage(i).lettre = ReTirage(element).lettre Then
Tirage(i).sorti = True: Exit For
End If
Next i
fnLettre = fnLettre & ReTirage(element).lettre
Next j
Erase Tirage, ReTirage
End Function

' ------------------------------------------------
' Sur l'évènement clic d'un bouton de formulaire :
' ------------------------------------------------
Private Sub Commande0_Click()
Dim rep As String, LeNombre As Integer
rep = InputBox("Nombre de lettres, nombre <&")
If StrPtr(rep) = 0 Or Not (IsNumeric(rep)) Then MsgBox "Opération
annulée": Exit Sub
If Len(rep) = 0 Then MsgBox "Tirage impossible": Exit Sub
If IsNumeric(rep) Then
If CInt(rep) > 26 Then
MsgBox "Tirage impossible"
Else
Initialisation ' Initialisation du tableau des lettres
LeNombre = CInt(rep)
MsgBox fnLettre(LeNombre)
End If
End If
End Sub

Salut,

Quelqu'un aurait t'il une idéee pour faire un tirage sans remise parmi n
éléments ?
Merci pour toute ade

--
A+
Eric
http://www.mpfa.info/
Archives : http://groups.google.fr/group/microsoft.public.fr.access?hl=fr