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

[koter]

Hallo Drommer,

1. Falls die vorgegebene Seite voll beschriftet wurde aber laut Excel noch Daten vorhanden sind, automatisch die nächste Seite anbricht. Da es öffters vorkommt, das eine Seite aufgrund der Datenmenge nicht ausreicht.

Der folgende Code erstellt ein neues Dokument mit den nötigen Seiten.
Das Ausgangsdokument wird nicht verändert.
Die Ebene mit den Ronden muss im Ausgangsdokument den Namen „Ronden“ tragen.

3. Komischerweise springe ich mit der TAB Taste tatsächlich von Textfeld zu Textfeld, allerdings von unten beginnend – warum nicht von der ersten Ronde? Gibt es da auch ne Einstellung in Corel? Zudem komme ich zwar indas Textfeld, jedoch kann ich nicht sofort überschreiben etc. gibt es dazu auch etwas?

Die Reihenfolge der Texte sollte jetzt so sein, wie Du es wünscht.
Sofort überschreiben kann ja nicht gehen. Die TAB-Taste hat ja beim Auswahlwerkzeug eine andere Funktion als beim Textwerkzeug. Beim Auswahlwerkzeug wird zum nächsten Objekt gesprungen, beim Textwerkzeug wird ein Tabulator eingefügt.

Du kannst aber die F8-Taste drücken, wenn das richtige Objekt ausgewählt ist, und dann den Text ändern. Ist die Änderung abgeschlossen kannst Du mit Strg-Leertaste zurück zum Auswahlwerkzeug wechseln.

Allgemein stört die Bearbeitungszeit des Makro etwas, da gibt es aber keine Möglichkeit der Beschleunigung oder? Bei 500 Datensätzen, dauert das dann doch ne ganze Weile.

Ich habe versucht das Makro zu beschleunigen. Auf meiner alten Kiste braucht es für 500 Datensätze allerdings immer noch 14 bis 15 Sekunden.

Code:

Sub RondenBeschriftenXL()

    Dim xl As Object
    Dim wb As Object
    Dim Zellen As Object
    Dim xlr As Object
    
    Dim ND As Document, AD As Document
    Dim p As Page
    Dim Ronden As New ShapeRange
    Dim Rondentext As Shape, s As Shape
    Dim TextEbene As New Layer
    Dim RondenEbene As Layer
    Dim TN As TreeNode
    
    Dim Z As Integer, DSZ As Integer, i As Integer
    Dim t1 As Single, t2 As Single
    Dim yZugabe As Double
    
    yZugabe = 0
    
    t1 = Timer()
    
    Set xl = GetObject(, "Excel.Application")
    Set wb = xl.ActiveWorkbook
    Set Zellen = wb.ActiveSheet.Cells
    
    ActiveDocument.Unit = cdrMillimeter
    
    For Each s In ActiveLayer.Shapes.All
        If s.Name = "Ronde" Then
            Ronden.Add s
        End If
    Next
    
    Set xlr = wb.ActiveSheet.Range("A:A")
    DSZ = xl.WorksheetFunction.CountA(xlr)
    
    Ronden.Sort " @shape1.Top * 100 - @shape1.Left > @shape2.Top * 100 - @shape2.Left"
    
    Set AD = ActiveDocument
    Set ND = Ronden.CreateDocumentFrom
    ND.Name = Replace(Replace("Ronden-" & Date, ".", "-") & "-" & Time, ":", "-")
    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 = Ronden(Z).CenterX
            .CenterY = Ronden(Z).CenterY - yZugabe
            .OrderToBack
        End With
        If Z < Ronden.Shapes.Count Then
            Z = Z + 1
        Else
            Z = 1
            Set p = ND.AddPages(1)
            p.Activate
            Set RondenEbene = p.Layers("Ronden")
            Set TextEbene = p.Layers("TextEbene")
            Set Ronden = ND.Pages(1).Layers("Ronden").Shapes.All.CopyToLayer(p.Layers("Ronden"))
        End If
    Next i
    
    If Z < Ronden.Count Then
        For i = Z To Ronden.Count
            Ronden(i).Delete
        Next i
    End If
    
    ActiveSelection.Shapes.All.RemoveFromSelection
    Application.Optimization = False
    ActiveWindow.Refresh
      
    t2 = Timer
    CorelScriptTools.EndWaitCursor
    AD.Activate
    MsgBox "fertig!" & vbCrLf & t2 - t1 & " Sekunden"
    
End Sub

Gruß

Koter