Corel Draw X6/X7 Seriendruckausgabe - Text automatisch anpassen

[destiny]

Hi Koter,

Klasse, dann habe ich ja alle Varianten durch

1000Dank

Schönen Abend noch
Destiny

[destiny]

Hallo noch einmal,

ich habe jetzt das mit dem Stauchen (ohne Leerzeichen) versucht.
Hier kommt leider eine Fehlermeldung - habe ich etwas falsch übernommen?

[ATTACH=CONFIG]12329[/ATTACH]

LG
Destiny

[koter]

Hallo Destiny,

Hier kommt leider eine Fehlermeldung - habe ich etwas falsch übernommen?

Ja, ich hatte die For-Blocks in Dein Makro aus Beitrag 19 eingebaut. Komplett muss es dann so aussehen:

Code:

Sub GrafiktextVerkleinern()
    Dim Seite As Page
    Dim Grafiktext As ShapeRange
    Dim Text As Shape
    Dim Breite As Double, cx As Double, cy As Double
    Breite = 80 '(%)
    ActiveDocument.Unit = cdrMillimeter
    ActiveDocument.ReferencePoint = cdrBottomCenter
    ActiveDocument.BeginCommandGroup "Text verkleinern"
    Optimization = True
    For Each Seite In ActiveDocument.Pages
        Set Grafiktext = Seite.Shapes.FindShapes(Query:="@type='text:artistic'")
        If Not Grafiktext Is Nothing Then
            For Each Text In Grafiktext
                'geschütztes Leerzeichen (Strg+Umschlt+Leertaste) durch Zeilenumbruch ersetzen
                If Text.SizeWidth > Seite.SizeWidth / 100 * Breite Then
                    Text.Text.Story = Replace(Text.Text.Story, Chr(160), vbCrLf)
                    Text.CenterX = Seite.CenterX
                    Text.CenterY = Seite.CenterY
                End If
                'Text stauchen
                If Text.SizeWidth > Seite.SizeWidth / 100 * Breite Then
                    Text.SizeWidth = Seite.SizeWidth / 100 * Breite
                    Text.CenterX = Seite.CenterX
                    Text.CenterY = Seite.CenterY
                End If
            Next
        End If
    Next
    Optimization = False
    ActiveDocument.EndCommandGroup
    ActiveWindow.Refresh
End Sub

Sonst habe ich nur noch die üblichen Einrückungen eingefügt.
So sieht man besser, wo welcher Block anfängt und endet.

Du kannst die nicht benötigten Zeilen auch einfach auskommentieren,
dann musst Du nichts löschen.

Bitte die folgende Frage nicht falsch verstehen! (ich bin einfach neugierig)
Programmierst Du schon lange?

Gruß

Koter

[destiny]

Hallo Koter,

vielen Dank - nein, das war meine erste Makro-Anwendung.
Bin ein Programmier-Dummy ;-)

Hatte nur nach einer Lösung gesucht, zwecks Anpassung bei Seriendruck.
Aber das geht anscheinend nur mit so einer Makro-Lösung.

Vielen Dank
Destiny

[destiny]

Hallo noch einmal,

ich hätte noch ein kleines Anliegen zur bereits erstellten Makro.
Diese funktioniert super - der Text wird durch die Angabe der %-Größe gestaucht.
Leider spring er dann automatisch immer auf die Seitenmitte.
Wenn der Text an der Stelle stehen bleiben soll - also die Y-Achse gleich bleibt,
was müsste ich im Code anpassen? (anstatt Seite.CenterY nehme ich an)

Code:

Sub GrafiktextVerkleinern()
    Dim Seite As Page
    Dim Grafiktext As ShapeRange
    Dim Text As Shape
    Dim Breite As Double, cx As Double, cy As Double
    Breite = 80 '(%)
    ActiveDocument.Unit = cdrMillimeter
    ActiveDocument.ReferencePoint = cdrBottomCenter
    ActiveDocument.BeginCommandGroup "Text verkleinern"
    Optimization = True
    For Each Seite In ActiveDocument.Pages
        Set Grafiktext = Seite.Shapes.FindShapes(Query:="@type='text:artistic'")
        If Not Grafiktext Is Nothing Then
            For Each Text In Grafiktext
                'geschütztes Leerzeichen (Strg+Umschlt+Leertaste) durch Zeilenumbruch ersetzen
                If Text.SizeWidth > Seite.SizeWidth / 100 * Breite Then
                    Text.Text.Story = Replace(Text.Text.Story, Chr(160), vbCrLf)
                    Text.CenterX = Seite.CenterX
                    Text.CenterY = Seite.CenterY
                End If
                'Text stauchen
                If Text.SizeWidth > Seite.SizeWidth / 100 * Breite Then
                    Text.SizeWidth = Seite.SizeWidth / 100 * Breite
                    Text.CenterX = Seite.CenterX
                    Text.CenterY = Seite.CenterY
                End If
            Next
        End If
    Next
    Optimization = False
    ActiveDocument.EndCommandGroup
    ActiveWindow.Refresh
End Sub

Merci vorab

Viele Grüße
Destiny

[koter]

Hallo Destiny,

Wenn der Text an der Stelle stehen bleiben soll - also die Y-Achse gleich bleibt,
was müsste ich im Code anpassen? (anstatt Seite.CenterY nehme ich an)

Code:

Sub GrafiktextVerkleinern()
    Dim Seite As Page
    Dim Grafiktext As ShapeRange
    Dim Text As Shape
    Dim Breite As Double, cx As Double, cy As Double
    Breite = 80 '(%)
    ActiveDocument.Unit = cdrMillimeter
    ActiveDocument.ReferencePoint = cdrBottomLeft
    ActiveDocument.BeginCommandGroup "Text verkleinern"
    Optimization = True
    For Each Seite In ActiveDocument.Pages
        Set Grafiktext = Seite.Shapes.FindShapes(Query:="@type='text:artistic'")
        If Not Grafiktext Is Nothing Then
            For Each Text In Grafiktext
                If Text.SizeWidth > Seite.SizeWidth / 100 * Breite Then
                    Text.SizeWidth = Seite.SizeWidth / 100 * Breite
                End If
            Next
        End If
    Next
    Optimization = False
    ActiveDocument.EndCommandGroup
    ActiveWindow.Refresh
End Sub

Der ReferencePoint wurde geändert und der Code zum Zentrieren und für den Umbruch entfernt.
Hoffentlich habe ich es richtig verstanden, wenn nicht, bitte noch einmal melden.

Gruß

Koter

[destiny]

Hallo Koter,

1000Dank - werde ich gleich testen

Merci vorab

LG
Destiny

[destiny]

Hallo noch einmal,

das hat soweit super funktioniert - der Text wird nun jedoch nach links "gestaucht".
D.h. wenn der Text vorher horizontal mittig war, wird er nach links gestaucht
und fängt daher auch außerhalb des "Schildes" bzw. der Seite an.

Das "Stauchen" müsste horizontal mittig passieren und die Y-Position des Textes
jedoch nicht verändert werden....

....ich hoffe, das ist einigermaßen verständlich ;-)


Ginge das auch irgendwie?

Vielen Dank vorab

Destiny

[koter]

Hallo Destiny,

Falls ich es jetzt richtig verstanden habe, musst Du nur die Zeile Text.CenterY = Seite.CenterY entfernen.

Manchmal habe ich ein Brett vor dem Kopf.

Gruß

Koter

[destiny]

Hallo Koter,

ja prima - genau das war es :icon_bravo:
Jetzt wird es zur Mitte hin gestaucht und bleibt an der Position.

Ich danke Dir vielmals

LG
Destiny