Juergens-Workshops.de Forum
Fortlaufende Nummern mit Rahmen für Aufkleber Druck/Plot - Druckversion

+- Juergens-Workshops.de Forum (https://forum.juergens-workshops.de)
+-- Forum: Corel Grafik Forum (https://forum.juergens-workshops.de/forumdisplay.php?fid=65)
+--- Forum: Corel Draw (https://forum.juergens-workshops.de/forumdisplay.php?fid=93)
+--- Thema: Fortlaufende Nummern mit Rahmen für Aufkleber Druck/Plot (/showthread.php?tid=38555)

Fortlaufende Nummern mit Rahmen für Aufkleber Druck/Plot - Litschi - 07.07.2023

Manchmal kommt es vor das wir Aufkleber mit fortlaufenden Nummern drucken / schneiden müssen.
Gibt es hier eine Corelfunktion oder einen Trick, oder sollen wir das über ein Macro vereinfachen?

[attachment=21667]

RE: Fortlaufende Nummern mit Rahmen für Aufkleber Druck/Plot - koter - 08.07.2023

Hallo Litschi,

Du kannst Dir das mit Seitenzahlen hinfummeln:

[Bild: seitenzahlen01cviby.jpg?891fa8b255a94d93...6c579270ab]

Du musst pro Nummer eine Seite einfügen, und die Aufteilung in der Druckvorschau einstellen.
Seriendruck könnte auch funktionieren, ich würde es wahrscheinlich mit einem Makro machen.

Gruß

Koter

RE: Fortlaufende Nummern mit Rahmen für Aufkleber Druck/Plot - Litschi - 09.07.2023

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
[attachment=21668]