Ajout d une msgbox dans une macro

  • Initiateur de la discussion Initiateur de la discussion raym1313
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

raym1313

XLDnaute Occasionnel
bonjour a tous

j ai la macro ci dessous ----

Sub Aléatoire()
Dim Arr(1 To 8, 1 To 1) As Integer
Dim i As Integer, j As Integer, k As Integer
For i = 1 To 8
Arr(i, 1) = i
Next i
Randomize Timer
For i = 1 To 8
j = Int(Rnd * (9 - i)) + 1
k = Arr(i, 1)
Arr(i, 1) = Arr(j, 1)
Arr(j, 1) = k
Next i
[D1😀8] = Arr
End Sub

qui me genere de D1 A D8 les chiffres de 1 a 8 dans un ordre aleatoire

mon souci c'est que je voudrai que ces chiffres arrivent les uns apres les autres en etant appele par une boite msgbox

je mexplique ces 8 chiffres correspondent a 8 tables qui vont etre attribuees
a 8 joueurs

le premier joueur arrive il appuie sur le bouton d'une boite msgbox
et le message apparait
vous avez tire le numero 7

quelque temps apres une autre equipe arrive et procede de la meme facon
il appuie et le msg affiche vous avez tire le numero 2

ect jusqu a ce que les 8 equipes aient tirées

par contre au fur et a mesure que les equipes tirent
je souhaiterai que les chiffres aillent en D1 PUIS D2 D3 ECT....

Merci pour votre aide

raymond 🙂 🙂 🙂

cordialement
 
Re : Ajout d une msgbox dans une macro

Bonjour Raymond,

regarde le code ci dessous, si j'aibien compris :

Code:
Option Explicit
Sub test()
Static x As New Collection
Dim n As Byte
Randomize
Do
    On Error Resume Next
    n = Int(8 * Rnd) + 1
    x.Add n, CStr(n)
Loop While Err.Number <> 0
On Error GoTo 0
MsgBox "Vous avez le numéro : " & x(x.Count)
Cells(x.Count, 4).Value = n
If x.Count = 8 Then MsgBox "Dernier numéro tiré !!!": Set x = Nothing
End Sub

bon après midi
@+
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
4
Affichages
205
  • Question Question
Microsoft 365 Export données
Réponses
4
Affichages
663
Réponses
3
Affichages
590
Réponses
5
Affichages
569
Réponses
23
Affichages
2 K
Réponses
9
Affichages
600
Réponses
2
Affichages
543
Réponses
2
Affichages
1 K
Retour