Corel Draw X6/X7 Seriendruckausgabe - Text automatisch anpassen

[koter]

Hallo Destiny,

Ich hoffe, ich nerve nicht ;-)

Nein, Jürgen hat das Forum ja eingerichtet, damit man sich über solche Fragen austauschen kann.
Wen das nervt, der soll es sich nicht anschauen.

...Gibt es auch eine Möglichkeit, den Text nicht allgemein zu verkleinern, sondern nur den Zeichenabstand entsprechend zu verringern?...

Die Möglichkeit gibt es, aber ob man es auch Praxis machen sollte?
Dabei kann nämlich so etwas herauskommen:



Und das, wo sich doch die Schriftkünstler so viel Mühe mit den Unterschneidungstabellen machen!

Das soll uns aber nicht hindern, damit herumzuspielen:

Code:

Sub KurztextVerschandeln()
    Dim Seite As Page
    Dim Kurztext As Shape
    Dim Breite As Double, BreiteA As Double
    Dim szp As Double
    Dim z As Double
    
    Breite = 80 '(%)
    
    ActiveDocument.Unit = cdrMillimeter
    ActiveDocument.ReferencePoint = cdrCenter
    Statusleiste 0, , True, "Text verschandeln"
    ActiveDocument.BeginCommandGroup "Kurztext verschandeln"
    Optimization = True
    szp = 100 / ActiveDocument.Pages.Count
    For Each Seite In ActiveDocument.Pages
        BreiteA = Seite.SizeWidth / 100 * Breite
        Set Kurztext = Seite.Shapes("Kurztext")
        If Not Kurztext Is Nothing Then
            For i = 0 To -100 Step -1
                Kurztext.Text.Story.RangeKerning = i
                If Kurztext.SizeWidth <= BreiteA Then Exit For
            Next i
        End If
        z = z + 1
        Statusleiste szp * z
        If Application.Status.Aborted Then
            Exit For
        End If
    Next
    Optimization = False
    ActiveDocument.EndCommandGroup
    Statusleiste szp * z, True
    ActiveWindow.Refresh
End Sub

Sub Statusleiste(Fortschritt As Long, Optional Ende As Boolean = False, Optional Start As Boolean = False, Optional Text As String = "")
    If Start Then
         Application.Status.BeginProgress CanAbort:=True
         Application.Status.SetProgressMessage Text
         Application.Status.UpdateProgress Fortschritt
    End If
    If Text <> "" Then
         Application.Status.SetProgressMessage Text
    End If
    Application.Status.UpdateProgress Fortschritt
    If Ende Then
         Application.Status.EndProgress
    End If
End Sub

Die Ausführung dauert lange, weil das Makro die Zielbreite nicht berechnet sondern so lange probiert, bis es passt.
Du kannst die Schrittweite der For-Schleife erhöhen, dann geht es schneller, ist aber nicht mehr so genau.

Um das Makro abbrechen zu können habe ich die Sub „Statusleiste“ eingebaut.
Man kann dadurch das Makro mit der ESC-Taste abbrechen.
Bis zur Version X6 erschien in der Statusleiste ein Fortschrittsbalken, mit X7 klappt das leider nicht mehr.

Viel Spaß beim Programmieren und beim Schnee schaufeln.

Gruß

Koter