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.
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.
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
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
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.
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.
Drommer schrieb: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]
Drommer schrieb: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.
Drommer schrieb: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).
Drommer schrieb: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
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
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")
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
18.06.2017, 17:39 (Dieser Beitrag wurde zuletzt bearbeitet: 18.06.2017, 17:45 von norre.)
Hallo Drommer
Drommer schrieb:...
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.
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.
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?
21.06.2017, 14:28 (Dieser Beitrag wurde zuletzt bearbeitet: 21.06.2017, 19:08 von 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]
![[Bild: ronden2l9sti.gif]](http://abload.de/img/ronden2l9sti.gif)
![[-]](https://forum.juergens-workshops.de/images/collapse.png)
