Numbering for tickets ?

Hello everyone!

This is an old discussion, but this problem is still relevant today, especially with the older versions - X3, X5

For this reason, I propose an entirely VBA solution. Better, faster code can certainly be written. This is code written in haste, without optimization.

I offer a working idea.

For the code to work, there must be one ticket on Page 1 near the top. There must be 3 numbers on the ticket, in the positions where we want the consecutive numbers to be printed.Before running the code, the ticket must be selected, along with the numbers on it.If the code is run from a form, fields can be made: number of tickets, starting number of generation, font size, number of numerical positions in the generated number, etc.For convenience, all these quantities are now set in the code. 

Private Sub tbGenerate()
‘tb means text boxes in user form
tbTicketsTotal = 20
tbTicketsOnPage = 4
tbNumPosition = 4
tbSize = 20
'TO WORK THIS CODE MUST:
'HAVE ONLY coONE TICKET ON PAGE 1 NEAR AT TOP MARGIN
'THIS TICKET MUST HAVE 3 NUMERIC FIELDS / NUMERIC TEXT
'THE TICKET MUST BE SELECTED 
ActiveSelection.Shapes.All.GroupPAGES_COUNT = ActiveDocument.Pages.Count
If ActiveDocument.Pages.Count > 1 Then
For X = 2 To PAGES_COUNT
ActiveDocument.Pages(2).Delete
Next
End If
Dim AAA, BBB As Shape
ActiveDocument.Pages(1).Shapes(1).MoveToLayer ActiveDocument.Pages(1).Layers("Layer 1")
 Set AAA = ActiveDocument.ActivePage.Layers("Layer 1").Shapes(1).Duplicate(0, -ActiveDocument.ActivePage.Layers("Layer 1").Shapes(1).SizeHeight) 
For X = 1 To 2
Set AAA = AAA.Duplicate(0, -AAA.SizeHeight)
Next
ActiveDocument.Pages(1).Shapes.All.Group
ActiveDocument.Pages(1).Shapes(1).MoveToLayer ActiveDocument.Pages(1).Layers("Layer 1")

ActiveDocument.BeginCommandGroup "DELETE PAGES 2-5-"
PAGE_COUNT = ActiveDocument.Pages.Count
If ActiveDocument.Pages.Count > 1 Then
For X = 2 To PAGES_COUNT
ActiveDocument.Pages(2).Delete
Next
End If
ActiveDocument.EndCommandGroup 
pages_tocreate = tbTicketsTotal / tbTicketsOnPage
ActivePage.Shapes(1).Copy
ActiveDocument.AddPages (pages_tocreate - 1)
For X = 2 To ActiveDocument.Pages.Count
ActiveDocument.Pages(1).Shapes.All.Copy
ActiveDocument.Pages(X).Layers("Layer 1").Paste
Next

 'ungroup all
Dim MPAGE As Page
For Each MPAGE In ActiveDocument.Pages
MPAGE.Shapes.All.UngroupAll
Next 

'numbering
Dim DSHAPE As Shape
Dim DPAGE As Page 
FLAG1 = 1
FLAG3 = 0 
For Each DPAGE In ActiveDocument.Pages 
For Each DSHAPE In DPAGE.Shapes 
If DSHAPE.Type = 6 Then 'text
FLAG3 = FLAG3 + 1   
If FLAG3 > 3 Then   
FLAG1 = FLAG1 + 1   
FLAG3 = 1
End If
VCENTERX = DSHAPE.CenterX
VCENTERY = DSHAPE.CenterY
For X = 1 To tbNumPosition
zerostring = zerostring & "0"
Next
If tbNumPosition = 1 Then
DSHAPE.Text.Range(0, 1000) = Format(FLAG1, "0")
End If
If tbNumPosition = 2 Then
DSHAPE.Text.Range(0, 1000) = Format(FLAG1, "00")
End If
If tbNumPosition = 3 Then
DSHAPE.Text.Range(0, 1000) = Format(FLAG1, "000")
End If
If tbNumPosition = 4 Then
DSHAPE.Text.Range(0, 1000) = Format(FLAG1, "0000")
End If
If tbNumPosition = 5 Then
DSHAPE.Text.Range(0, 1000) = Format(FLAG1, "00000")
End If
DSHAPE.Text.Range(0, 100).Size = tbSize
DSHAPE.CenterX = VCENTERX
DSHAPE.CenterY = VCENTERY
End If
Next
Next
End Sub  

Greetings!