09.11.2016, 16:33
Hallo Koter,
ich habe das jetzt bei X6 ausprobiert - hat problemlos funtkioniert.
Aber durch den Zeichenabstand wird das sehr schnell unbrauchbar.
Was müsste ich an diesem Code ändern, damit nicht die ganze Größe des Textes geändert wird, sondern nur die Breite entsprechend gestaucht?
Merci vorab :sei_gepriesen:
ich habe das jetzt bei X6 ausprobiert - hat problemlos funtkioniert.
Aber durch den Zeichenabstand wird das sehr schnell unbrauchbar.
Was müsste ich an diesem Code ändern, damit nicht die ganze Größe des Textes geändert wird, sondern nur die Breite entsprechend gestaucht?
Zitat:Sub GrafiktextVerkleinern()
Dim Seite As Page
Dim Grafiktext As ShapeRange
Dim Text As Shape
Dim Breite 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
If Text.SizeWidth > Seite.SizeWidth / 100 * Breite Then
Text.Stretch 1 / Text.SizeWidth * (Seite.SizeWidth / 100 * Breite)
End If
Next
End If
Next
Optimization = False
ActiveDocument.EndCommandGroup
ActiveWindow.Refresh
End Sub
Merci vorab :sei_gepriesen: