Problemme macro

Résolu
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

3 réponses

  1. Contributeur
    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
    1. je ne peut metre de lien car contien une macro
      0
      1. Contributeur
        ???
        0
    2. 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
      1. Contributeur
        Bonjour,

        il faut coller le lien fourni ici.
        eric
        0
      2. Contributeur
        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
      3. merci j'avais pas vus cette faute
        0