Fortlaufende Nummern mit Rahmen für Aufkleber Druck/Plot

[Litschi]

OK, da ich nicht nur quadratische Umrisse für die Zahlenaufkleber brauche, habe ich mir eine schnelle Hilfe geschrieben. Funktioniert für mich, getestet in X3.
Text-Standardeinstellungen bei mir sind Arial (24 Punkt). 11 Spalten und 14 Reihen passen dann gut auf A4.

Hier gibt es bestimmt noch viel Raum für Verbesserungen, freut mich wenn es jemandem hilft.

Code:

Sub Zahlenaufkleber()
   ' Macro erzeugt fortlaufende Nummern zentriert in einer Form
   ' Erklärungen im Code
   '
   ' Litschi.de
   Dim s1 As Shape, s2 As Shape, startnum As Integer, i As Integer, ix As Integer, ti As Integer, Spalten As Integer, Reihen As Integer
   ActiveDocument.Unit = cdrMillimeter                                                     ' Dokument Einheiten
   startnum = InputBox("Starten mit...")                                                   ' Abfrage der Startzahl
   Spalten = InputBox("Wie viele Spalten?") - 1                                            ' Abfrage Spaltenanzahl
   Reihen = InputBox("Wie viele Reihen?") - 1                                              ' Abfrage Reihenanzehl
   ActiveDocument.BeginCommandGroup ("zahlen")
   Optimization = True
   ti = startnum
   For i = startnum To (startnum + Reihen)
           For ix = startnum To (startnum + Spalten)
               ' Text erzeugen, hier mit führender Null bei 3 Stellen "001"
               Set s1 = ActiveLayer.CreateArtisticText(5 + x, 280 + y, Format(ti, "000"))  ' Anfangsposition
               s1.Fill.UniformColor.CMYKAssign 0, 0, 0, 100                                ' Textfarbe
               s1.Outline.SetNoOutline                                                     ' kein Umriss
               s1.Text.Story.Bold = True                                                   ' Textstil = Fett
               ' Form erzeugen Quadrat
               Set s2 = ActiveLayer.CreateRectangle(0, 0, 17, 17)                          ' Form / Position und Größe
                   ' Alternative Form Kreis
                   'Set s2 = ActiveLayer.CreateEllipse2(0, 0, 8.2, -8.2, 90#, 90#, False)
               s2.Fill.ApplyNoFill                                                         ' keine Füllung
               'Eigenschaften der Form festlegen / Umriss Magenta
               s2.Outline.SetProperties 0.0762, OutlineStyles(0), CreateCMYKColor(0, 100, 0, 0), ArrowHeads(0), ArrowHeads(0), False, False, cdrOutlineButtLineCaps, cdrOutlineMiterLineJoin, 0#, 100, , , 5#
               s2.AlignToShape cdrAlignHCenter, s1, cdrTextAlignBoundingBox                ' Horizontal über Text zenrieren
               s2.AlignToShape cdrAlignVCenter, s1, cdrTextAlignBoundingBox                ' Vertikal über Text zentrieren
               x = x + 18                                                                  ' Position anpassen
               ti = ti + 1                                                                 ' Zahl um 1 erhöhen
           Next ix
       x = 0
       y = y - 20
   Next i
   Optimization = False
   ActiveWindow.Refresh
End Sub