Sub Macro1()
Optimization = True
Dim OrigSelection As ShapeRange
Set OrigSelection = ActiveSelectionRange
ActiveDocument.Unit = cdrMillimeter
Dim s1 As Shape
Dim s2 As Shape
Dim down As Double
down = 0
rightS = 0
For i = 1 To 300 '0
For j = 0 To 3
down = down + 25
Set s1 = ActiveLayer.CreateRectangle2(0 + rightS, 0 - down, 1000, 25)
For k = 0 To 3
Set s2 = ActiveLayer.CreateArtisticText(250 * k + 100 + rightS, 0 - down + 3, "MКАР-01" & Right("000" & i, 4))
s2.Text.Story.Font = "Impact"
s2.Text.Story.Size = 60
Next k
Next j
If i Mod 34 = 0 Then
rightS = rightS + 1005
down = 0
End If
Debug.Print i
Next i
Optimization = False
ActiveWindow.Refresh
End Sub