Créer des cartons du loto quine

Re,

C'est préférable que tu me donnes ton mail.

@+

je te l'envoi en MP

Bonjour,

Dans ce nouveau fichier... J'ai corrigé un petit bug d'impression du fichier précédent et ajouté un impression x 9 (A3)

A ajuster éventuellement en fonction de votre imprimante car je n'ai pas de A3

Attention en guise d'ajustement vous ne pouvez jouer que sur la largeur des colonnes et la hauteur des lignes et éventuellement sur la taille de police. Tout ajout de ligne ou de colonne sur les feuilles d'impression détruirait la programmation...

A+

J'ai edité un peut j'ai mis ceci pour avoir 24 cartons.

   Range(Cells((k * 27) + 1, 1), Cells((k * 9) + 3, 9)).Copy WsD.Range("A1")
   Range(Cells((k * 27) + 4, 1), Cells((k * 9) + 6, 9)).Copy WsD.Range("A5")
   Range(Cells((k * 27) + 7, 1), Cells((k * 9) + 9, 9)).Copy WsD.Range("A9")
   Range(Cells((k * 27) + 10, 1), Cells((k * 9) + 12, 9)).Copy WsD.Range("A13")
   Range(Cells((k * 27) + 13, 1), Cells((k * 9) + 15, 9)).Copy WsD.Range("A17")
   Range(Cells((k * 27) + 16, 1), Cells((k * 9) + 18, 9)).Copy WsD.Range("A21")
   ' 2Colonne
   Range(Cells((k * 27) + 19, 1), Cells((k * 9) + 21, 9)).Copy WsD.Range("K1")
   Range(Cells((k * 27) + 22, 1), Cells((k * 9) + 24, 9)).Copy WsD.Range("K5")
   Range(Cells((k * 27) + 25, 1), Cells((k * 9) + 27, 9)).Copy WsD.Range("K9")
   Range(Cells((k * 27) + 28, 1), Cells((k * 9) + 30, 9)).Copy WsD.Range("K13")
   Range(Cells((k * 27) + 31, 1), Cells((k * 9) + 33, 9)).Copy WsD.Range("K17")
   Range(Cells((k * 27) + 34, 1), Cells((k * 9) + 36, 9)).Copy WsD.Range("K21")
   ' 3Colonne
   Range(Cells((k * 27) + 37, 1), Cells((k * 9) + 39, 9)).Copy WsD.Range("U1")
   Range(Cells((k * 27) + 40, 1), Cells((k * 9) + 42, 9)).Copy WsD.Range("U5")
   Range(Cells((k * 27) + 43, 1), Cells((k * 9) + 45, 9)).Copy WsD.Range("U9")
   Range(Cells((k * 27) + 46, 1), Cells((k * 9) + 48, 9)).Copy WsD.Range("U13")
   Range(Cells((k * 27) + 49, 1), Cells((k * 9) + 51, 9)).Copy WsD.Range("U17")
   Range(Cells((k * 27) + 52, 1), Cells((k * 9) + 54, 9)).Copy WsD.Range("U21")
    '4Colonne
   Range(Cells((k * 27) + 55, 1), Cells((k * 9) + 57, 9)).Copy WsD.Range("AE1")
   Range(Cells((k * 27) + 58, 1), Cells((k * 9) + 60, 9)).Copy WsD.Range("AE5")
   Range(Cells((k * 27) + 61, 1), Cells((k * 9) + 63, 9)).Copy WsD.Range("AE9")
   Range(Cells((k * 27) + 64, 1), Cells((k * 9) + 66, 9)).Copy WsD.Range("AE13")
   Range(Cells((k * 27) + 67, 1), Cells((k * 9) + 69, 9)).Copy WsD.Range("AE17")
   Range(Cells((k * 27) + 70, 1), Cells((k * 9) + 72, 9)).Copy WsD.Range("AE21")

Sauf que quand je fait l'impression, cela fait un collage de tout les carton sans espace .... Je ne vois pas ou et le bug ..

EDIT : Il manque surement une ligne clear, mais je n'arrive pas a la mettre, quel et la commande svp ?

Bonsoir,

Essaie ça :

Sub ImpGrid24()
   Range(Cells(1, 1), Cells(3, 9)).Copy WsD.Range("A1")
   Range(Cells(4, 1), Cells(6, 9)).Copy WsD.Range("K1")
   Range(Cells(7, 1), Cells(9, 9)).Copy WsD.Range("U1")
   Range(Cells(10, 1), Cells(12, 9)).Copy WsD.Range("AE1")
   Range(Cells(13, 1), Cells(15, 9)).Copy WsD.Range("A5")
   Range(Cells(16, 1), Cells(18, 9)).Copy WsD.Range("K5")
   Range(Cells(19, 1), Cells(21, 9)).Copy WsD.Range("U5")
   Range(Cells(22, 1), Cells(24, 9)).Copy WsD.Range("AE5")
   Range(Cells(25, 1), Cells(27, 9)).Copy WsD.Range("A9")
   Range(Cells(28, 1), Cells(30, 9)).Copy WsD.Range("K9")
   Range(Cells(31, 1), Cells(33, 9)).Copy WsD.Range("U9")
   Range(Cells(34, 1), Cells(36, 9)).Copy WsD.Range("AE9")
   Range(Cells(37, 1), Cells(39, 9)).Copy WsD.Range("A13")
   Range(Cells(40, 1), Cells(42, 9)).Copy WsD.Range("K13")
   Range(Cells(43, 1), Cells(45, 9)).Copy WsD.Range("U13")
   Range(Cells(46, 1), Cells(48, 9)).Copy WsD.Range("AE13")
   Range(Cells(49, 1), Cells(51, 9)).Copy WsD.Range("A17")
   Range(Cells(52, 1), Cells(54, 9)).Copy WsD.Range("K17")
   Range(Cells(55, 1), Cells(57, 9)).Copy WsD.Range("U17")
   Range(Cells(58, 1), Cells(60, 9)).Copy WsD.Range("AE17")
   Range(Cells(61, 1), Cells(63, 9)).Copy WsD.Range("A21")
   Range(Cells(64, 1), Cells(66, 9)).Copy WsD.Range("K21")
   Range(Cells(67, 1), Cells(69, 9)).Copy WsD.Range("U21")
   Range(Cells(70, 1), Cells(72, 9)).Copy WsD.Range("AE21")
   WsD.PrintOut Preview:=True
End Sub

A+

Bonjour,

Je laisse à Galopin le soin de te répondre en passant Bonjour Galopin.

SBX59 tu n'a fait aucun commentaire sur le projet que je t'ai envoyé concernant le LotoQuine.

Ou c'est pas du tout ce que tu recherches?

@+

@cfn3cfn Oui le projet est bon, et je t'en remercie.

@galopin01 Super sa fonctionne, sauf que quand je veut faire plusieurs page, il me mais toujours les meme numero, je prend pas de nouvelle grilles

bonjour,

Régler "i" manuellement avant de lancer la macro (de 1 à 20 feuilles maxi

Attention à bien lancer la macro à partir de la feuille "Grilles"

Dim i%, k%
i = 3 'i = nombre de feuilles de 24 grilles différentes
For k = 0 To i - 1
   Range(Cells((k * 72) + 1, 1), Cells((k * 72) + 3, 9)).Copy WsD.Range("A1")
   Range(Cells((k * 72) + 4, 1), Cells((k * 72) + 6, 9)).Copy WsD.Range("K1")
   Range(Cells((k * 72) + 7, 1), Cells((k * 72) + 9, 9)).Copy WsD.Range("U1")
   Range(Cells((k * 72) + 10, 1), Cells((k * 72) + 12, 9)).Copy WsD.Range("AE1")
   Range(Cells((k * 72) + 13, 1), Cells((k * 72) + 15, 9)).Copy WsD.Range("A5")
   Range(Cells((k * 72) + 16, 1), Cells((k * 72) + 18, 9)).Copy WsD.Range("K5")
   Range(Cells((k * 72) + 19, 1), Cells((k * 72) + 21, 9)).Copy WsD.Range("U5")
   Range(Cells((k * 72) + 22, 1), Cells((k * 72) + 24, 9)).Copy WsD.Range("AE5")
   Range(Cells((k * 72) + 25, 1), Cells((k * 72) + 27, 9)).Copy WsD.Range("A9")
   Range(Cells((k * 72) + 28, 1), Cells((k * 72) + 30, 9)).Copy WsD.Range("K9")
   Range(Cells((k * 72) + 31, 1), Cells((k * 72) + 33, 9)).Copy WsD.Range("U9")
   Range(Cells((k * 72) + 34, 1), Cells((k * 72) + 36, 9)).Copy WsD.Range("AE9")
   Range(Cells((k * 72) + 37, 1), Cells((k * 72) + 39, 9)).Copy WsD.Range("A13")
   Range(Cells((k * 72) + 40, 1), Cells((k * 72) + 42, 9)).Copy WsD.Range("K13")
   Range(Cells((k * 72) + 43, 1), Cells((k * 72) + 45, 9)).Copy WsD.Range("U13")
   Range(Cells((k * 72) + 46, 1), Cells((k * 72) + 48, 9)).Copy WsD.Range("AE13")
   Range(Cells((k * 72) + 49, 1), Cells((k * 72) + 51, 9)).Copy WsD.Range("A17")
   Range(Cells((k * 72) + 52, 1), Cells((k * 72) + 54, 9)).Copy WsD.Range("K17")
   Range(Cells((k * 72) + 55, 1), Cells((k * 72) + 57, 9)).Copy WsD.Range("U17")
   Range(Cells((k * 72) + 58, 1), Cells((k * 72) + 60, 9)).Copy WsD.Range("AE17")
   Range(Cells((k * 72) + 61, 1), Cells((k * 72) + 63, 9)).Copy WsD.Range("A21")
   Range(Cells((k * 72) + 64, 1), Cells((k * 72) + 66, 9)).Copy WsD.Range("K21")
   Range(Cells((k * 72) + 67, 1), Cells((k * 72) + 69, 9)).Copy WsD.Range("U21")
   Range(Cells((k * 72) + 70, 1), Cells((k * 72) + 72, 9)).Copy WsD.Range("AE21")
   WsD.PrintOut Preview:=True
Next
End Sub

A+

Voila le bon code :

Sub ImpGrid24()
Dim i%, k%
i = WsC.Range("T4") / 24
For k = 0 To i - 1
       Range(Cells((k * 72) + 1, 1), Cells((k * 72) + 3, 9)).Copy WsD.Range("A1")
       Range(Cells((k * 72) + 4, 1), Cells((k * 72) + 6, 9)).Copy WsD.Range("K1")
       Range(Cells((k * 72) + 7, 1), Cells((k * 72) + 9, 9)).Copy WsD.Range("U1")
       Range(Cells((k * 72) + 10, 1), Cells((k * 72) + 12, 9)).Copy WsD.Range("AE1")
       Range(Cells((k * 72) + 13, 1), Cells((k * 72) + 15, 9)).Copy WsD.Range("A5")
       Range(Cells((k * 72) + 16, 1), Cells((k * 72) + 18, 9)).Copy WsD.Range("K5")
       Range(Cells((k * 72) + 19, 1), Cells((k * 72) + 21, 9)).Copy WsD.Range("U5")
       Range(Cells((k * 72) + 22, 1), Cells((k * 72) + 24, 9)).Copy WsD.Range("AE5")
       Range(Cells((k * 72) + 25, 1), Cells((k * 72) + 27, 9)).Copy WsD.Range("A9")
       Range(Cells((k * 72) + 28, 1), Cells((k * 72) + 30, 9)).Copy WsD.Range("K9")
       Range(Cells((k * 72) + 31, 1), Cells((k * 72) + 33, 9)).Copy WsD.Range("U9")
       Range(Cells((k * 72) + 34, 1), Cells((k * 72) + 36, 9)).Copy WsD.Range("AE9")
       Range(Cells((k * 72) + 37, 1), Cells((k * 72) + 39, 9)).Copy WsD.Range("A13")
       Range(Cells((k * 72) + 40, 1), Cells((k * 72) + 42, 9)).Copy WsD.Range("K13")
       Range(Cells((k * 72) + 43, 1), Cells((k * 72) + 45, 9)).Copy WsD.Range("U13")
       Range(Cells((k * 72) + 46, 1), Cells((k * 72) + 48, 9)).Copy WsD.Range("AE13")
       Range(Cells((k * 72) + 49, 1), Cells((k * 72) + 51, 9)).Copy WsD.Range("A17")
       Range(Cells((k * 72) + 52, 1), Cells((k * 72) + 54, 9)).Copy WsD.Range("K17")
       Range(Cells((k * 72) + 55, 1), Cells((k * 72) + 57, 9)).Copy WsD.Range("U17")
       Range(Cells((k * 72) + 58, 1), Cells((k * 72) + 60, 9)).Copy WsD.Range("AE17")
       Range(Cells((k * 72) + 61, 1), Cells((k * 72) + 63, 9)).Copy WsD.Range("A21")
       Range(Cells((k * 72) + 64, 1), Cells((k * 72) + 66, 9)).Copy WsD.Range("K21")
       Range(Cells((k * 72) + 67, 1), Cells((k * 72) + 69, 9)).Copy WsD.Range("U21")
       Range(Cells((k * 72) + 70, 1), Cells((k * 72) + 72, 9)).Copy WsD.Range("AE21")
   WsD.PrintOut Preview:=True
Next
End Sub

Par contre j'aimerais un code pour verifier si il n'y a pas de carton en doublon. Et si possible en crée plus ( pour faire plus de 1000 feuille ) Pouvez vous me donner un code ? ou debut de code que je doit completé.

Merci

Plus de 1000 FEUILLES ?

24000 cartons ?

bonjour,

Je donne ici le code pour 1500 cartons soit 4500 lignes

Pour plus, YAKA faire une multiplication...

Préalablement il faut formater la feuille grille sur le nombre de lignes voulues

(YAKA Copier/Coller la grille de 1500 lignes plusieurs fois.)

Ensuite lancer la macro NewGrid.

Option Explicit
Sub NewGrid()
RazFrm
Marquage
Tirage
TestDoublons
End Sub
Sub RazFrm()
'RAZ et mise en forme des grilles
Dim i%, j%, K%
Application.ScreenUpdating = False
Range("A1:I4500").ClearContents
Range("A1:I4500").Interior.ColorIndex = xlNone
Randomize
With Worksheets("Grilles")
For i = 1 To 4500
For j = 1 To 4
K = Int((9 * Rnd) + 1)
If .Cells(i, K).Interior.ColorIndex = 7 Then j = j - 1
.Cells(i, K).Interior.ColorIndex = 7
Next
Next
End With
End Sub
Sub Marquage()
Dim a%, i%, j%
Application.ScreenUpdating = False
With Worksheets("Grilles")
   For i = 1 To 4500  'Pour chaque ligne
     For j = 1 To 9   'pour chaque colonne
         If .Cells(i, j).Interior.ColorIndex <> 7 Then
            .Cells(i, j).Value = 1
         End If
     Next
   Next
End With
End Sub
Sub Tirage()
Dim a%, i%, j%, Arr
Arr = [A1:i4500].Value
With Worksheets("Grilles")
   For j = 1 To 9
      For i = 1 To 4498 Step 3
         If Arr(i, j) = 1 Then Arr(i, j) = TIR(j)
         If Arr(i + 1, j) = 1 Then Arr(i + 1, j) = TIR(j)
         If Arr(i + 2, j) = 1 Then Arr(i + 2, j) = TIR(j)
         If Arr(i + 1, j) > 0 Then
            Do While Arr(i + 1, j) = Arr(i, j) Or Arr(i + 2, j) = Arr(i + 1, j)
               Arr(i + 1, j) = TIR(j)
            Loop
         End If
         If Arr(i + 2, j) > 0 Then
            Do While Arr(i + 2, j) = Arr(i + 1, j) Or Arr(i + 2, j) = Arr(i, j)
               Arr(i + 2, j) = TIR(j)
            Loop
         End If
      Next
   Next
[A1:i4500] = Arr
End With
End Sub
Function TIR(j)
Dim a%, x%, b%
a = j - 1
   Select Case j
   Case 1: x = 9: b = 1
   Case 9: x = 11
   Case Else: x = 10
   End Select
TIR = Int(10 * a + (x * Rnd + b))
End Function
Sub TestDoublons()
Dim i%, K%, Z$, d, Arr
Set d = CreateObject("Scripting.Dictionary")
Arr = [A1:i4500].Value
On Error Resume Next
For i = 1 To 4500
For K = 1 To 9
Z = IIf(Arr(i, K) > 0, Z & Arr(i, K) & " ", Z)
Next
d.Add Z, ""
Z = ""
Next
'Pour lister les tirages
'[AA1].Resize(d.Count) = Application.Transpose(d.keys)
MsgBox "Il y a : " & 4500 - d.Count & " doublons"
End Sub

Il y a en moyenne 1,12 ligne en doublon sur 4500 (testé sur 450 000) ce qui semble exclure la possibilité de cartons pleins en doublon... Donc si on y tient absolument il suffit de relancer le tirage jusqu'à satisfaction ! (plus longue série avec doublon : 12 tirages)

Nombre maximum de doublon (pour 1 tirage : 3)

Les N° étant tirés de manière aléatoire la moyenne des sorties pour chaque N° est de 250 (MIN 215 MAX 303) sur mon échantillon.

Et bien sur il n'est pas possible de déterminer un N° Privilégié chaque tirage est équiprobable.

La macro d'impression ne change pas...

A+

Super merci mon projet et donc terminé. je vous remercie tout les deux.

bonjour à tous

j ai lu votre projet et je trouve cela super intéressant

je voulais savoir

on organise un loto pour mon association:

Les cartons peuvent ils être utilisé ?

Est il possible de mettre une petit ligne en pointillé pour les découper

Est il possible de mettre un petit logo de l association pour marqué les carton

merci cordialement

Oui tout est possible

il faut bien sûre le logo et litres pointillés il faut da je également où les placer

je voudrais cela genre

et si cela est possible d avoir les cases en bleu ciel à la place du fuchia

merci cordialement

Bonjour,

Le logo doit être en jpg.

J'ai pris bonne note du changement de couleur.

Je voudrai savoir qu'est ce que tu as comme version.

Je ne pourrais pas trop m'occuper de cela en ce moment je dois quitter le département.

Par contre je verrai un ami pour qu'il puisse prendre les chose en main pendant mon absence.

Je pense normalement comme il a était sur le projet il a du recevoir comme moi ta demande.

Amicalement

Je te remercie de ta réponse trés rapide

Pour le moment he ne suis plus dispo avant lundi 21 donc je pourrai te fournir les infos à toi ou ton amis

Cas ma prochaine connexion

Merci

OK

Je quitte le département pour 20 jours

@+

bonjour,

Je ne suis pas certain que les pointillés soient une riche idée.. Quoi qu'il en soit je les ai mis tu devras te débrouiller pour jouer sur la hauteur des marges haut et bas en fonction de ton imprimante le cas échéant et sur la hauteur des lignes 4, 5 ,9 ,10.

Attention toutefois de ne pas modifier la hauteur des autres lignes ce qui affecterait aussi le dimensionnement des logos...

J'ai également intégré 2 petits logos aléatoires par carton : YORAPUKA remplacer les images par ton propre logo format jpg et de dimensions 51 x 69 (pixels)

A+

bonjour

merci pour votre aide le logo doit être copier coller sur toute les cases ou dois je l inserer quelque part précisement pour qu'il soit mis aléatoirement sur toute mes grilles

merci