Problemme macro

Résolu
Dandy_danbe Messages postés 108 Date d'inscription   Statut Membre Dernière intervention   -  
Dandy_danbe Messages postés 108 Date d'inscription   Statut Membre Dernière intervention   -
Bonjour,
j'ai un problème avec cette macro
les nombre du derniere tirage depasse le max de 90
il sagit d' un tirage pour le bingo ( 12 carte ) la derniere n'est pas corecte?
voir g41 en fin de programme

Sub Bingo()
Dim Dic As Object, Arr(), X As Integer
Dim A As Integer, B As Integer, Nb As Integer

Application.ScreenUpdating = False
With Worksheets("blad1") 'Nom feuille à adapter
With .Range("A2")
.Value = "B"
.Offset(, 1) = "I"
.Offset(, 2) = "N"
.Offset(, 3) = "G"
.Offset(, 4) = "O"
End With
With .Range("A2").Resize(16, 5)
.Font.Size = 16
.Font.Bold = True
.HorizontalAlignment = xlCenter
End With
End With
Set Dic = CreateObject("Scripting.Dictionary")
A = 1: B = 18
For X = 1 To 5
Randomize
Do Until i = 5
Nb = Application.RandBetween(A, B)
If Not Dic.Exists(Nb) Then
Dic.Add (Nb), (Nb)
i = i + 1
End If
Loop
With Worksheets("blad1")
.Range("A2").Offset(1, X - 1).Resize(i) = Application.Transpose(Dic.items)
End With
i = 0: A = A + 18: B = B + 18
Dic.RemoveAll
Next



Application.ScreenUpdating = False
With Worksheets("blad1") 'Nom feuille à adapter
With .Range("A10")
.Value = "B"
.Offset(, 1) = "I"
.Offset(, 2) = "N"
.Offset(, 3) = "G"
.Offset(, 4) = "O"
End With
With .Range("a10").Resize(16, 5)
.Font.Size = 16
.Font.Bold = True
.HorizontalAlignment = xlCenter
End With
End With
Set Dic = CreateObject("Scripting.Dictionary")
A = 1: B = 18
For X = 1 To 5
Randomize
Do Until i = 5
Nb = Application.RandBetween(A, B)
If Not Dic.Exists(Nb) Then
Dic.Add (Nb), (Nb)
i = i + 1
End If
Loop
With Worksheets("blad1")
.Range("a10").Offset(1, X - 1).Resize(i) = Application.Transpose(Dic.items)
End With
i = 0: A = A + 18: B = B + 18
Dic.RemoveAll
Next

Application.ScreenUpdating = False
With Worksheets("blad1") 'Nom feuille à adapter
With .Range("a18")
.Value = "B"
.Offset(, 1) = "I"
.Offset(, 2) = "N"
.Offset(, 3) = "G"
.Offset(, 4) = "O"
End With
With .Range("a18").Resize(16, 5)
.Font.Size = 16
.Font.Bold = True
.HorizontalAlignment = xlCenter
End With
End With
Set Dic = CreateObject("Scripting.Dictionary")
A = 1: B = 18
For X = 1 To 5
Randomize
Do Until i = 5
Nb = Application.RandBetween(A, B)
If Not Dic.Exists(Nb) Then
Dic.Add (Nb), (Nb)
i = i + 1
End If
Loop
With Worksheets("blad1")
.Range("a18").Offset(1, X - 1).Resize(i) = Application.Transpose(Dic.items)
End With
i = 0: A = A + 18: B = B + 18
Dic.RemoveAll
Next

Application.ScreenUpdating = False
With Worksheets("blad1") 'Nom feuille à adapter
With .Range("a25")
.Value = "B"
.Offset(, 1) = "I"
.Offset(, 2) = "N"
.Offset(, 3) = "G"
.Offset(, 4) = "O"
End With
With .Range("a25").Resize(16, 5)
.Font.Size = 16
.Font.Bold = True
.HorizontalAlignment = xlCenter
End With
End With
Set Dic = CreateObject("Scripting.Dictionary")
A = 1: B = 18
For X = 1 To 5
Randomize
Do Until i = 5
Nb = Application.RandBetween(A, B)
If Not Dic.Exists(Nb) Then
Dic.Add (Nb), (Nb)
i = i + 1
End If
Loop
With Worksheets("blad1")
.Range("a25").Offset(1, X - 1).Resize(i) = Application.Transpose(Dic.items)
End With
i = 0: A = A + 18: B = B + 18
Dic.RemoveAll
Next

Application.ScreenUpdating = False
With Worksheets("blad1") 'Nom feuille à adapter
With .Range("a33")
.Value = "B"
.Offset(, 1) = "I"
.Offset(, 2) = "N"
.Offset(, 3) = "G"
.Offset(, 4) = "O"
End With
With .Range("a33").Resize(16, 5)
.Font.Size = 16
.Font.Bold = True
.HorizontalAlignment = xlCenter
End With
End With
Set Dic = CreateObject("Scripting.Dictionary")
A = 1: B = 18
For X = 1 To 5
Randomize
Do Until i = 5
Nb = Application.RandBetween(A, B)
If Not Dic.Exists(Nb) Then
Dic.Add (Nb), (Nb)
i = i + 1
End If
Loop
With Worksheets("blad1")
.Range("a33").Offset(1, X - 1).Resize(i) = Application.Transpose(Dic.items)
End With
i = 0: A = A + 18: B = B + 18
Dic.RemoveAll
Next

Application.ScreenUpdating = False
With Worksheets("blad1") 'Nom feuille à adapter
With .Range("a41")
.Value = "B"
.Offset(, 1) = "I"
.Offset(, 2) = "N"
.Offset(, 3) = "G"
.Offset(, 4) = "O"
End With
With .Range("a41").Resize(16, 5)
.Font.Size = 16
.Font.Bold = True
.HorizontalAlignment = xlCenter
End With
End With
Set Dic = CreateObject("Scripting.Dictionary")
A = 1: B = 18
For X = 1 To 5
Randomize
Do Until i = 5
Nb = Application.RandBetween(A, B)
If Not Dic.Exists(Nb) Then
Dic.Add (Nb), (Nb)
i = i + 1
End If
Loop
With Worksheets("blad1")
.Range("a41").Offset(1, X - 1).Resize(i) = Application.Transpose(Dic.items)
End With
i = 0: A = A + 18: B = B + 18
Dic.RemoveAll
Next



Application.ScreenUpdating = True

Application.ScreenUpdating = False
With Worksheets("blad1") 'Nom feuille à adapter
With .Range("g2")
.Value = "B"
.Offset(, 1) = "I"
.Offset(, 2) = "N"
.Offset(, 3) = "G"
.Offset(, 4) = "O"
End With
With .Range("g2").Resize(16, 5)
.Font.Size = 16
.Font.Bold = True
.HorizontalAlignment = xlCenter
End With
End With
Set Dic = CreateObject("Scripting.Dictionary")
g = 1: h = 18
For X = 1 To 5
Randomize
Do Until i = 5
Nb = Application.RandBetween(g, h)
If Not Dic.Exists(Nb) Then
Dic.Add (Nb), (Nb)
i = i + 1
End If
Loop
With Worksheets("blad1")
.Range("g2").Offset(1, X - 1).Resize(i) = Application.Transpose(Dic.items)
End With
i = 0: g = g + 18: h = h + 18
Dic.RemoveAll
Next

Application.ScreenUpdating = True

Application.ScreenUpdating = False
With Worksheets("blad1") 'Nom feuille à adapter
With .Range("g10")
.Value = "B"
.Offset(, 1) = "I"
.Offset(, 2) = "N"
.Offset(, 3) = "G"
.Offset(, 4) = "O"
End With
With .Range("g10").Resize(16, 5)
.Font.Size = 16
.Font.Bold = True
.HorizontalAlignment = xlCenter
End With
End With
Set Dic = CreateObject("Scripting.Dictionary")
g = 1: h = 18
For X = 1 To 5
Randomize
Do Until i = 5
Nb = Application.RandBetween(g, h)
If Not Dic.Exists(Nb) Then
Dic.Add (Nb), (Nb)
i = i + 1
End If
Loop
With Worksheets("blad1")
.Range("g10").Offset(1, X - 1).Resize(i) = Application.Transpose(Dic.items)
End With
i = 0: g = g + 18: h = h + 18
Dic.RemoveAll
Next

Application.ScreenUpdating = True

Application.ScreenUpdating = False
With Worksheets("blad1") 'Nom feuille à adapter
With .Range("g18")
.Value = "B"
.Offset(, 1) = "I"
.Offset(, 2) = "N"
.Offset(, 3) = "G"
.Offset(, 4) = "O"
End With
With .Range("g18").Resize(16, 5)
.Font.Size = 16
.Font.Bold = True
.HorizontalAlignment = xlCenter
End With
End With
Set Dic = CreateObject("Scripting.Dictionary")
g = 1: h = 18
For X = 1 To 5
Randomize
Do Until i = 5
Nb = Application.RandBetween(g, h)
If Not Dic.Exists(Nb) Then
Dic.Add (Nb), (Nb)
i = i + 1
End If
Loop
With Worksheets("blad1")
.Range("g18").Offset(1, X - 1).Resize(i) = Application.Transpose(Dic.items)
End With
i = 0: g = g + 18: h = h + 18
Dic.RemoveAll
Next

Application.ScreenUpdating = True

Application.ScreenUpdating = False
With Worksheets("blad1") 'Nom feuille à adapter
With .Range("g25")
.Value = "B"
.Offset(, 1) = "I"
.Offset(, 2) = "N"
.Offset(, 3) = "G"
.Offset(, 4) = "O"
End With
With .Range("g25").Resize(16, 5)
.Font.Size = 16
.Font.Bold = True
.HorizontalAlignment = xlCenter
End With
End With
Set Dic = CreateObject("Scripting.Dictionary")
g = 1: h = 18
For X = 1 To 5
Randomize
Do Until i = 5
Nb = Application.RandBetween(g, h)
If Not Dic.Exists(Nb) Then
Dic.Add (Nb), (Nb)
i = i + 1
End If
Loop
With Worksheets("blad1")
.Range("g25").Offset(1, X - 1).Resize(i) = Application.Transpose(Dic.items)
End With
i = 0: g = g + 18: h = h + 18
Dic.RemoveAll
Next

Application.ScreenUpdating = True
Application.ScreenUpdating = False
With Worksheets("blad1") 'Nom feuille à adapter
With .Range("g33")
.Value = "B"
.Offset(, 1) = "I"
.Offset(, 2) = "N"
.Offset(, 3) = "G"
.Offset(, 4) = "O"
End With
With .Range("g33").Resize(16, 5)
.Font.Size = 16
.Font.Bold = True
.HorizontalAlignment = xlCenter
End With
End With
Set Dic = CreateObject("Scripting.Dictionary")
g = 1: h = 18
For X = 1 To 5
Randomize
Do Until i = 5
Nb = Application.RandBetween(g, h)
If Not Dic.Exists(Nb) Then
Dic.Add (Nb), (Nb)
i = i + 1
End If
Loop
With Worksheets("blad1")
.Range("g33").Offset(1, X - 1).Resize(i) = Application.Transpose(Dic.items)
End With
i = 0: g = g + 18: h = h + 18
Dic.RemoveAll
Next

Application.ScreenUpdating = False
With Worksheets("blad1") 'Nom feuille à adapter
With .Range("g41")
.Value = "B"
.Offset(, 1) = "I"
.Offset(, 2) = "N"
.Offset(, 3) = "G"
.Offset(, 4) = "O"
End With
With .Range("g41").Resize(16, 5)
.Font.Size = 16
.Font.Bold = True
.HorizontalAlignment = xlCenter
End With
End With
Set Dic = CreateObject("Scripting.Dictionary")
g = 1: h = 18
For X = 1 To 5
Randomize
Do Until i = 5
Nb = Application.RandBetween(A, B)
If Not Dic.Exists(Nb) Then
Dic.Add (Nb), (Nb)
i = i + 1
End If
Loop
With Worksheets("blad1")
.Range("g41").Offset(1, X - 1).Resize(i) = Application.Transpose(Dic.items)
End With
i = 0: g = g + 18: h = h + 18
Dic.RemoveAll
Next

ActiveWindow.ScrollWorkbookTabs Position:=xlFirst
Sheets("Blad1").Select
Range("n1").Select
Selection.Copy
Sheets("Blad1").Select
Range("c1").Select
Selection.PasteSpecial Paste:=xlPasteValues, skipBlanks:=False
End Sub
Sub Afrukken()
'
' Afrukken Macro
'

'
ExecuteExcel4Macro "PRINT(2,1,1,1,,,,,,,,2,,,TRUE,,FALSE)"
ExecuteExcel4Macro "PRINT(2,1,1,1,,,,,,,,2,,,TRUE,,FALSE)"
End Sub



A voir également:

3 réponses

eriiic Messages postés 24603 Date d'inscription   Statut Contributeur Dernière intervention   7 275
 
Bonjour,

tu as une icone pour mettre en forme le code. Là ce n'est pas digeste...
Le mieux est de déposer le fichier sur cjoint.com et de coller ici le lien ici.

eric
0
Dandy_danbe Messages postés 108 Date d'inscription   Statut Membre Dernière intervention  
 
je ne peut metre de lien car contien une macro
0
eriiic Messages postés 24603 Date d'inscription   Statut Contributeur Dernière intervention   7 275
 
???
0
Dandy_danbe Messages postés 108 Date d'inscription   Statut Membre Dernière intervention  
 
voir fichier le problème ce situe dans les celulles (g41:k46) les monbre sont superieur a 90 ce qui n'est pas le cas dans toutes les autre cartes
https://www.cjoint.com/?DIqi3ri64Fl
0
eriiic Messages postés 24603 Date d'inscription   Statut Contributeur Dernière intervention   7 275
 
Bonjour,

il faut coller le lien fourni ici.
eric
0
Dandy_danbe Messages postés 108 Date d'inscription   Statut Membre Dernière intervention  
 
0
eriiic Messages postés 24603 Date d'inscription   Statut Contributeur Dernière intervention   7 275
 
Nb = Application.RandBetween(A, B)
avec A=91 et B=108 ne peut pas donner autre chose.
C'est g et h qu'il faut utiliser.

eric
0
Dandy_danbe Messages postés 108 Date d'inscription   Statut Membre Dernière intervention  
 
merci j'avais pas vus cette faute
0