Numérotation de tickets de Tombola

Bonjour,

Je fais partie de l'association des parents d'élèves de l'école de mes enfants, et nous organisons une tombola. Habituellement nous imprimons des feuilles avec la trame des billets de tombola, et chacun des membres participent en inscrivant les numéros de tickets sur la souche, et sur le ticket. Je me dis qu'il doit bien y avoir une solution pour une numérotation automatique... On peut imaginer à l'impression que les numéros de tickets se complètent ? Sur 1 feuille A4 nous avons 6 tickets, et nous souhaitons +/- 1500 tickets .. Serait-ce à faire par une macro ? . .

Pouvez vous m'aider ?

Merci d'avance pour nos enfants !

re,

c'est assez facile dès que vous avez les premier 6 tickets. Il y a aussi des images/textes sur ce ticket ?

avez-vous un fichier avec cette première feuille ?

1.500 tickets = 250 feuilles, l'idée est de créer 250 feuilles dans excel, de modifier les numérotations dans ces feuilles, de les imprimer en une fois et de supprimer les 249 feuilles qu'on avait avjouté.

Oui il y a 2 images sur chaque ticket. J'ai fait le +1 sur les tickets par rapport au ticket précédent ;

Mais c'est assez long de faire 250 feuilles, non ?

Bonjour

perso 6 tickets sur une feuille A4 ça fait des sacrés ticket

apercu d'un exemple les colonne foncées seraient les souches

bonjour LucieMarie,

j'utilise une autre méthode parce que ces images me causent des problèmes, donc j'utilise la feuille "Feuille1" et la cellule I1, je l'utilise comme numéro de la page. Puis, si vous demandez 60 tickets = 10 page, j'imprime 10 pages individuelles. Je ne sais pas comment l'imprimante supporte cela, elle sera surchargée ??? Donc, après chaque 10eme page, la macro s'arrête et vous pouvez continuer avec F5.

Pour le moment, il y a un guillemet ' devant ".printout", comme ça, cette ligne est "commentaire". Si vous êtes prêt pour imprimer, supprimer ce guillemet en face de ".printout" et ajoute ce guillemet en face de ".printpreview"

et ... commencer avec 18 tickets au lieu de 1.500

Bonjour LucieMarie et le forum
Voici ma proposition.
Je n'ai fait que pour 6 pages pour le test.
Cdt
Papy Henri

2ème proposition: Impression de 50 pages soit 300 N°s pour éviter une saturation de l'imprimante. Ensuite il suffit de mettre une apostrophe devient la 1ère ligne de code commençant par For et de l'enlever sur 2ème, etc.

Sub imprime()
    With Sheets("Feuil1")
     For n = 1 To 300 Step 6 'pour 50 feuilles soit 300 n°s
     'for n=301 to 600 step 6 'pour 50 feuilles supplémentaires, soit 600 n°s
     'for n=601 to 900 step 6 'pour 50 feuilles supplémentaires, soit 900 n°s
     'for n=901 to 1200 step 6 'pour 50 feuilles supplémentaires,soit 1200 N°s
     'for 1201 to 1500 step 6 'pour 50 feuilles supplémentaires,soit 1500 N°s
    .Range("b7") = n
    .PrintOut
   ' .PrintPreview
    Next n
    End With
End Sub

re bonjour

pour ma part j'ai revisité le concept

j'ai commencé par

1° réduire le départ à 1 tiket sur la feuille vierge

et j'appelle ma macro par le click sur l'image des ballons et un imputbox va s'ouvrir

il ne reste plus qu'a taper le nombre de ticket que tu veux

2° ensuite on va copier cette plage le nombre de ticket que tu veux
3°ensuite on va instruire les Numéro de Ticket
4° on détermine toute la plage utilisée comme Zone à imprimer
5° ensuite on va mettre les sauts de page(6ticket) donc 9 * 6 lignes pour une pages 54 lignes
6° on envoie a l'imprimante
7° on reviens sur la feuille une fois imprimé
8° on clear tout on revient a un seul ticket

ça permet de garder un fichier qui pèze rien du tout

démonstration

le VBA

Sub FirstImage_Cliquer()
    Dim X&
    X = Val(Application.InputBox("Entrez le nombre de Ticket SVP", "Impression de Ticket de Tombola", 6))
    If X > 0 Then création_carnet X
End Sub
Sub création_carnet(nbticket&)
    Dim cel As Range, Plage As Range, I&, X&, Sauts
    Set Plage = [A1:D9]
    Application.ScreenUpdating = True

    For I = 1 To nbticket
        Plage.Copy Cells((9 * I) + 1, 1)
        DoEvents
    Next
    X = 0
    For Each cel In [B:B].Resize(ActiveSheet.UsedRange.Rows.Count)
        If cel.Offset(, -1) = "N°" Then
            X = X + 1
            cel = X
            cel.Offset(, 2) = X
        End If
    Next

    ActiveSheet.PageSetup.PrintArea = ActiveSheet.UsedRange.Address

    If ActiveSheet.HPageBreaks.Count > 0 Then
        For Each Sauts In ActiveSheet.HPageBreaks
            Sauts.Delete
        Next
    End If
    For I = 55 To ActiveSheet.UsedRange.Rows.Count Step 54
        ActiveSheet.HPageBreaks.Add Before:=Cells(I, 1)
    Next

    ActiveSheet.PrintPreview
    'ActiveSheet.PrintOut
        clearpage
End Sub
Sub clearpage()
    For Each shap In ActiveSheet.Shapes
        If shap.TopLeftCell.Row > 1 Then shap.Delete
    Next
    Rows(10).Resize(2500).Delete
End Sub

terminé c'est propre et net