CorelDraw für Schilder, Etiketten zu Lasern verwenden - Möglichkeiten....

[koter]

Hallo Drommer,

noch habe ich nicht herausgefunden, woran das Makro bei Dir hakt. Bei mir funktioniert es.
Wir haben es ja mit einer Kombination aus Vorlage und Makro zu tun, und ich habe ja nur das Makro und nicht Deine Vorlagen.

Vielleicht kannst Du ja etwas mit mit folgendem Makro mit Benutzerdialog anfangen:



Das Makro erstellt eine Vorlage aus einem Objekt, und übernimmt die Beschriftung und Sortierung. Das ist ja von Hand wirklich sehr mühselig. Falls Du das ausprobieren willst, musst Du die GMS aus dem Anhang in Dein GMS-Verzeichnis kopieren oder es über den Makro-Manager laden.
Gestartet wird es über die Prozedur Hauptmodul.start().

Das Makro können wir natürlich noch anpassen, ich kenne ja Deine Anforderungen und Deinen Arbeitsablauf nicht genau. Wenn Dir das alles zu üppig ist, können wir aber auch an dem anderen Makro weiter basteln. Wenn Du das willst, wäre es hilfreich, wenn Du eine Deiner Vorlagen, an der das Makro gescheitert ist, an einen Beitrag anhängst.

Bei Deiner Änderung hasst Du die Namens-Eigenschaft des Datei-Objekts erwischt, deshalb funktioniert das nicht.

Ich habe gerade einiges „um die Ohren“ und musste Dich deshalb so lange warten lassen. Ich versuche auf den nächsten Beitrag schneller zu antworten.

Gruß

Koter

[Drommer]

Hallo Koter,
ich habe mir die Datei mal angeschaut, wäre mit Sicherheit auch ganz interessant, aber das vorherige Makro scheint mir praktikabler für meine Anwendungsfälle zu sein.

Ich würde mir zukünftig gerne für jedes Schild eine Vorlage basteln, die mit dem Makro kompatibel ist. Die Schilder sind matten förmig auf Folie geklebt, sodass ich immer eine Vorlage pro Matte erstelle. So viele verschiedene gibt es da nicht… (vielleicht 8-12)
Wie schon gesagt das vorherige Makro reicht für die Anwendung vollkommend aus, falls die Missstände noch behoben werden können. Im Anhang jetzt mal eine Vorlage von mir…

Probleme:
1. Sortierung: Die Sortierung funktioniert auf der ersten Seite tadellos, jedoch nicht auf den weiteren… Ich
komme einfach nicht dahinter warum?!

2. Makro: Das Makro sollte funktionieren ohne auf die Benennung der Objekte zu achten. Sprich wenn ich ein
neues Schild zeichne und dann in eine Kurve konvertiere habe ich ja zwangsmäßig die Bezeichnung
„Kurve“ für mein Objekt. Gleiches gilt für die angelegte Ebene die von Corel aus immer „Ebene1“
lautet. Meine versuche das Makro daraufhin umzuändern scheiterten alle…
Es wäre echt klasse wenn du dich meinem Problem nochmals kurz widmen könntest.

Gruß
Drommer

[koter]

Hallo Drommer,

der Fehler lag bei dem Makro, Deine Vorlage ist OK.

Ich glaube mir sind Deine Anforderungen jetzt etwas klarer geworden.

Ich habe das Makro jetzt so umgebaut, dass es so wenig wie möglich auf die Vorlage zugreift.
Sortiert wird jetzt nur noch in der Druckdatei:

Code:

Dim xl As Object
Dim wb As Object
Dim Tabelle As Object
Dim Zellen As Object
Dim xlr As Object

Sub Start()

    Dim Dateiname As String
    
    Dateiname = Replace(Replace("Druckdatei-" & Date, ".", "-") & "-" & Time, ":", "-")
    
    If xltest Then
        Call Druckdatei(Dateiname)
    End If
    
    Set xl = Nothing
    Set wb = Nothing
    Set Tabelle = Nothing
    Set Zellen = Nothing
    Set xlr = Nothing
    
End Sub

Private Function xltest() As Boolean
    On Error GoTo Fehler
    xltest = False
    Set xl = GetObject(, "Excel.Application")
    Set wb = xl.activeWorkbook
    Set Tabelle = wb.activeSheet
    Set xlr = Tabelle.Range("A:A")
    xltest = True
    Exit Function
Fehler:
    If Err = 429 Then
         MsgBox "Fehler bem Datenaustausch mit Excel!", vbCritical, "Fehler"
    Exit Function
    End If
    MsgBox "Ein Fehler ist aufgetreten:" & vbCrLf & _
    Error(Err) & vbCrLf & vbCrLf & _
    "Das Makro wird beendet.", vbCritical, "Fehler"
End Function


Private Sub Druckdatei(ByVal DName As String)
    On Error GoTo Fehler
    Dim ND As Document, AD As Document
    Dim p As Page
    Dim NDRonden As ShapeRange
    Dim Rondentext As Shape, s As Shape
    Dim TextEbene As New Layer
    Dim RondenEbene As Layer, L As Layer
    Dim Zeiterfassung As Boolean
    
    Dim Z As Integer, DSZ As Integer, i As Integer
    Dim t1 As Single, t2 As Single
    Dim yZugabe As Double
    
    yZugabe = 0
    Zeiterfassung = True
    
    If Zeiterfassung Then t1 = Timer()
    Set Zellen = wb.activeSheet.Cells
    
    ActiveDocument.Unit = cdrMillimeter
    
    DSZ = xl.WorksheetFunction.CountA(xlr)
        
    Set AD = ActiveDocument
    Set ND = ActiveLayer.Shapes.All.CreateDocumentFrom
    
    For Each L In ActivePage.AllLayers
        If Not L.IsSpecialLayer Then
            L.Name = "Ronden"
            Set NDRonden = L.Shapes.All
            Exit For
        End If
    Next

    NDRonden.Sort " @shape1.Top * 100 - @shape1.Left > @shape2.Top * 100 - @shape2.Left"
    ND.Name = DName
    ND.Unit = cdrMillimeter
    
    Set TextEbene = ND.ActivePage.CreateLayer("TextEbene")
    
    CorelScriptTools.BeginWaitCursor
    Application.Optimization = True

    Z = 1
    For i = 1 To DSZ
        Set Rondentext = TextEbene.CreateArtisticText(0, 0, Replace(Zellen(i, 1), "#", vbCrLf))
        With Rondentext
            .Text.Story.Size = 12
            .Text.Story.Alignment = cdrCenterAlignment
            .CenterX = NDRonden(Z).CenterX
            .CenterY = NDRonden(Z).CenterY - yZugabe
            .OrderToBack
        End With
        If Z < NDRonden.Shapes.Count Then
            Z = Z + 1
            NDRonden(Z).OrderToBack
        Else
            Z = 1
            Set p = ND.AddPages(1)
            p.Activate
            Set RondenEbene = p.Layers("Ronden")
            Set TextEbene = p.Layers("TextEbene")
            Set NDRonden = ND.Pages(1).Layers("Ronden").Shapes.All.CopyToLayer(p.Layers("Ronden"))
        End If
    Next i
    
    If Z < NDRonden.Count Then
        For i = Z To NDRonden.Count
            NDRonden(i).Delete
        Next i
    End If
    
    ActiveSelection.Shapes.All.RemoveFromSelection
    Application.Optimization = False
    ActiveWindow.Refresh
      
    If Zeiterfassung Then t2 = Timer
    CorelScriptTools.EndWaitCursor
    If Zeiterfassung Then MsgBox "fertig!" & vbCrLf & t2 - t1 & " Sekunden"
    ND.Dirty = False
    AD.Activate
    Exit Sub
    
Fehler:
    Application.Optimization = False
    MsgBox "Ein Fehler ist aufgetreten:" & vbCrLf & _
    Error(Err) & vbCrLf & vbCrLf & _
    "Prozedur: RondenBeschriftenXL" & vbCrLf & _
    "Das Makro wird beendet.", vbCritical, "Fehler"
        
End Sub

Die Ebene und die Objekte müssen nicht mehr umbenannt werden.
Es dürfen aber keine zusätzlichen Objekte auf der Ebene liegen.
Das Makro könnte diese nicht mehr von den zu beschriftenden Objekten unterscheiden,
es verarbeitet einfach alle Objekte der Ebene.

Ich hatte noch keine Zeit, das Makro ausgiebig zu testen, aber ich hoffe es funktioniert.

Gruß

Koter

[Drommer]

Hallo Koter,

das Makro funktioniert, die ersten Schilder sind gelasert! Vielen Dank dafür.
Aber wie es immer so ist beim „machen“ bekommt man dann Optimierungen in den Sinn...
Verbesserungswünsche aus der Praxis:

1. Im Anhang habe ich mal zwei Matten abfotografiert. Der Laser hat eine Arbeitsfläche von 600x400 mm (B x H). Die abgebildeten Matten haben ca. 260mm (B)ich könnte demnach zwei dieser Matten nebeneinanderlegen. Untereinander kommt nie vor da der Arbeitsbereich nicht groß genug ist.
Ich bin mir sicher, dass ich es über Seiteneinstellung in der Druckvorschau (2 Seiten nebeneinander) irgendwie in Corel einstellen könnte jedoch scheint mir das zu umständlich.

Ist es irgendwie machbar über Makros so etwas zu steuern? Vielleicht über die Breitengröße? Ist B > 300mm dann nur eine Seite ist B<300mm dann Matte daneben setzen... klar das Matte 3&4 dann auf Seite 2 landen würden.
Dabei sollte sich dann aber die Sortierung wie im Bild dargestellt abbilden.

2. Zeilenabstand im Makro auf 220% (wurde bei Corel in % angegeben) einstellen. Diese Zahl irgendwo darstellen um Sie ggf. mal zu ändern.

3. Sonderzeichen zu Corel hinzufügen? Könnte man Sonderzeichen in Corel hinzufügen – bin zurzeit auf der Suche nach einem Erdungs – Symbol.

Wiedermal vielen Dank im Voraus.

Gruß
Drommer

[ATTACH=CONFIG]12764[/ATTACH]

[Hartmut]

Hallo Drommer,
das Erdungssymbol findest Du in der Schrift Electronics unter dem großen W.
Electronics gehört zum Lieferumfang von Corel.

[norre]

Hallo Drommer

3. Sonderzeichen zu Corel hinzufügen? Könnte man Sonderzeichen in Corel hinzufügen ...

Also als Schrift:
-->Text-->Zeichen einfügen, im sich öffnenden Andockfenster zuerst die entsprechende Schrift auswählen, siehe Hartmut, und dann das benötigte Symbol aus dem unteren Fenster direkt auf die Arbeitspläche ziehen oder kopieren und einfügen oder, falls vorhanden mit dem Tastencode.
[ATTACH=CONFIG]12765[/ATTACH]

Wenn du dir die Arbeitsweise mit Symbolen und Symbolbibliotheken anschauen willst, hier gibts eine Anleitung
https://juergens-workshops.de/board/show...beiten-mit
es gibt dazu im Forum auch noch mehrere Beiträge

Gruß
Norre

[koter]

Hallo Drommer,

1. ...Ist es irgendwie machbar über Makros so etwas zu steuern? Vielleicht über die Breitengröße? Ist B > 300mm dann nur eine Seite ist B<300mm dann Matte daneben setzen... klar das Matte 3&4 dann auf Seite 2 landen würden...

ich gehe davon aus, dass Du mit „Breitengröße“ die Seitenbreite meinst. Ich habe das Makro danach geändert.
Teste mal, ob ich das richtig verstanden habe.

2. Zeilenabstand im Makro auf 220% (wurde bei Corel in % angegeben) einstellen. Diese Zahl irgendwo darstellen um Sie ggf. mal zu ändern.

Im Makro sind zwischen den Kommentarzeilen „Einstellungen“ und „Einstellungen_Ende“ einige Variablen, die Du ändern kannst. Falls Du Nachkommastellen brauchst, musst Du als Trennzeichen den Punkt nehmen, das Komma würde einen Fehler verursachen
(VBA ist ja in Englisch).

3. Sonderzeichen zu Corel hinzufügen? Könnte man Sonderzeichen in Corel hinzufügen – bin zurzeit auf der Suche nach einem Erdungs – Symbol.

Da hältst Du Dich am besten an das, was Hartmut und Norre geschrieben haben, die beiden wissen da besser Bescheid als ich.

Code:

Dim xl As Object
Dim wb As Object
Dim Tabelle As Object
Dim Zellen As Object
Dim xlr As Object

Sub Start()

    Dim Dateiname As String
    
    Dateiname = Replace(Replace("Druckdatei-" & Date, ".", "-") & "-" & Time, ":", "-")
    
    If xltest Then
        Call Druckdatei(Dateiname)
    End If
    
    Set xl = Nothing
    Set wb = Nothing
    Set Tabelle = Nothing
    Set Zellen = Nothing
    Set xlr = Nothing
    
End Sub

Private Function xltest() As Boolean
    On Error GoTo Fehler
    xltest = False
    Set xl = GetObject(, "Excel.Application")
    Set wb = xl.activeWorkbook
    Set Tabelle = wb.activeSheet
    Set xlr = Tabelle.Range("A:A")
    xltest = True
    Exit Function
Fehler:
    If Err = 429 Then
         MsgBox "Fehler bem Datenaustausch mit Excel!", vbCritical, "Fehler"
    Exit Function
    End If
    MsgBox "Ein Fehler ist aufgetreten:" & vbCrLf & _
    Error(Err) & vbCrLf & vbCrLf & _
    "Das Makro wird beendet.", vbCritical, "Fehler"
End Function


Private Sub Druckdatei(ByVal DName As String)
    On Error GoTo Fehler
    Dim ND As Document, AD As Document
    Dim p As Page
    Dim NDRonden As ShapeRange, NDRonden1 As ShapeRange
    Dim Rondentext As Shape, s As Shape
    Dim TextEbene As New Layer
    Dim RondenEbene As Layer, L As Layer
    Dim Zeiterfassung As Boolean, KeinAbstand As Boolean
    
    Dim Z As Integer, DSZ As Integer, i As Integer
    Dim t1 As Single, t2 As Single
    Dim yZugabe As Double, LX As Double, Mattenbreite As Double
    Dim Zeilenabstand As Single, Schriftgröße As Single
    
    Zeiterfassung = True
    
    If Zeiterfassung Then t1 = Timer()
    Set Zellen = wb.activeSheet.Cells
    
    ActiveDocument.Unit = cdrMillimeter
    
    'Einstellungen_________________________
    
    yZugabe = 0
    KeinAbstand = False
    
    Mattenbreite = 260
    Schriftgröße = 18.5
    Zeilenabstand = 220
    KeinAbstand = False

    'Einstellungen_Ende____________________
    
    DSZ = xl.WorksheetFunction.CountA(xlr)
        
    Set AD = ActiveDocument
    
    Set ND = ActiveLayer.Shapes.All.CreateDocumentFrom
    
    For Each L In ActivePage.AllLayers
        If Not L.IsSpecialLayer Then
            L.Name = "Ronden"
            Set NDRonden = L.Shapes.All
            Exit For
        End If
    Next
    LX = NDRonden.LeftX
    NDRonden.Sort " @shape1.Top * 100 - @shape1.Left > @shape2.Top * 100 - @shape2.Left"
    ND.Name = DName
    ND.Unit = cdrMillimeter
    
    Set TextEbene = ND.ActivePage.CreateLayer("TextEbene")
    
    CorelScriptTools.BeginWaitCursor
    Application.Optimization = True

    Z = 1
    For i = 1 To DSZ
        Set Rondentext = TextEbene.CreateArtisticText(0, 0, Replace(Zellen(i, 1), "#", vbCrLf))
        With Rondentext
            With .Text.Story
                 .Size = Schriftgröße
                 .SetLineSpacing cdrPercentOfCharacterHeightLineSpacing, Zeilenabstand
                 .Alignment = cdrCenterAlignment
            End With
            .CenterX = NDRonden(Z).CenterX
            .CenterY = NDRonden(Z).CenterY - yZugabe
            .OrderToBack
        End With
        If Z < NDRonden.Shapes.Count Then
            Z = Z + 1
            NDRonden(Z).OrderToBack
        Else
            Z = 1
            If ND.ActivePage.SizeWidth / Mattenbreite >= 2 And _
                NDRonden.SizeWidth <= Mattenbreite And _
                ND.ActivePage.RightX - NDRonden.RightX >= Mattenbreite _
            Then
                Set NDRonden = NDRonden.CopyToLayer(ActivePage.Layers("Ronden"))
                NDRonden.OrderToBack
                If KeinAbstand Then
                    NDRonden.LeftX = NDRonden.SizeWidth
                Else
                    NDRonden.LeftX = Mattenbreite
                End If
                
            Else
                Set p = ND.AddPages(1)
                p.Activate
                Set RondenEbene = p.Layers("Ronden")
                Set TextEbene = p.Layers("TextEbene")
                Set NDRonden = NDRonden.CopyToLayer(p.Layers("Ronden"))
                NDRonden.LeftX = LX
            End If
        End If
    Next i
    
    If Z < NDRonden.Count Then
        For i = Z To NDRonden.Count
            NDRonden(i).Delete
        Next i
    End If
    
    ActiveSelection.Shapes.All.RemoveFromSelection
    Application.Optimization = False
    ActiveWindow.Refresh
      
    If Zeiterfassung Then t2 = Timer
    CorelScriptTools.EndWaitCursor
    If Zeiterfassung Then MsgBox "fertig!" & vbCrLf & t2 - t1 & " Sekunden"
    ND.Dirty = False
    AD.Activate
    Exit Sub
    
Fehler:
    Application.Optimization = False
    MsgBox "Ein Fehler ist aufgetreten:" & vbCrLf & _
    Error(Err) & vbCrLf & vbCrLf & _
    "Prozedur: RondenBeschriftenXL" & vbCrLf & _
    "Das Makro wird beendet.", vbCritical, "Fehler"
        
End Sub

Gruß

Koter

[norre]

Hallo Drommer

...
Ich bin mir sicher, dass ich es über Seiteneinstellung in der Druckvorschau (2 Seiten nebeneinander) irgendwie in Corel einstellen könnte jedoch scheint mir das zu umständlich....

Nur zur Info wie man mehrere Seiten auf ein Blatt in Corel drucken kann.

In der Druckvorschau links das zweite Icon "Umbruchlayout" auswählen.
nun kannst du oben in der Eigenschaftsleiste die Anzahl der Spalten und Zeilen auf einen Blatt auswählen, bei dir wären es also zwei Spalten, somit also zwei Seiten auf einem Blatt.

Anschließend könntest du noch den Abstand zwischen den Spalten einstellen.
Siehe Screenshot hier:
https://juergens-workshops.de/board/show...post162181 sowie auch die Seitenränder.

Wenn du wieder auf das Pfeilwerkzeug gehtst erhälst du auch wieder die Druckvorschau.
Deine Einstellungen kannst du dann links oben in der Eigenschaftsleiste zum schnellen aufrufen auch abspeichern.

Gruß
Norre

[Drommer]

Hallo Koter
Habe das neue Makro ausgiebig getestet! Erkenne kaum Schwachstellen, so langsam nähere ich mich meinem Ziel :lol:…

-Matten nebeneinander noch verfeinern: Wenn ich im Makro die Mattenbreite (in der Datei 52x22.cdr)auf 260.4 einstelle, legt er die zweite Matte schön bündig dran. Anders wäre das bei einer breiteren Matte (hier würde ja nur eine Seite erstellt) Um nicht unnötig viele Makro´s für unterschiedliche Mattenbreiten zu erstellen, gibt es die Möglichkeit das Maß 260.4 ( letzte Linie auf X-Achse) autom. rauszulesen und dann zu entscheiden passt es verdoppelt auf die 600mm Arbeitsfläche oder wird es nur einzeln dargestellt. Wenn verdoppelt dann automatisch auf 0mm Abstand danebensetzen.

-Gibt es eine Möglichkeit Eingabefelder für Schriftgröße und Zeilenabstand zu generieren um diese vor dem Start des Makros zu definieren? Wenn das zu kompliziert ist, werde ich mir Makros in den verschiedenen Ausführungen erstellen… geht ja auch! Das andere wäre halt ziemlich lässig;-)

-Erdungssymbol: Danke für den Hinweis @Hartmut & norre, leider finde ich die Schriftart nicht. Vielleicht Versionsabhängig? Habe CorelDraw Graphics Suite X7 – Special Edition – OEM. Könnte man sich diese Schriftart zukünftig irgendwie reinladen?

Gruß
Drommer

[norre]

Hallo Drommer,
da du ja eine Vollversion hast (indiz: VBA vorhanden) sollte die Schrift eigentlich dabei sein.
Auf der Corel-DVD sollte sie unter Fonts-->Symbol zu finden sein. Der Dateiname wäre: Electron.ttf
[ATTACH=CONFIG]12772[/ATTACH]

Gruß
Norre