Benutzung auf eigene Gefahr ! |
Beschreibung |
Das Makro exportiert alle Seiten in einer CrorelDraw Datei in das TIFF Format. Das ist besonders als Vorlage für Animationen geeignet, da der Export nach GIF in älteren Versionen (bis 8) schlechte Qualität liefert und ab Version 10 fehlerhaft ist. Die TIFF-Dateien eignen sich als Vorlage für Animation Shop Pro. Das Programm fragt nach einem Ausgabepfad und wiederholt diese Abfrage, bis ein gültiger Pfad eingegeben wurde. |
VBA-Quelltext |
Public Sub SeitenSpeichern_TIFF() Dim SeiteNr As Integer, Seite As Page Dim Pfad As String, FormatStr As String, DateiName As String Dim opt As New StructExportOptions On Error GoTo AbbruchBeiFehler CorelScript.SuppressPainting '*** Ausgabepfad erstellen Pfad = "C:\Temp\Corel\" Do Pfad = InputBox("Ausgabepfad für die Bilder", "Export nach TIFF", Pfad) If Pfad = "" Then Exit Sub If Right(Pfad, 1) <> "\" Then Pfad = Pfad & "\" Loop Until Dir$(Pfad, vbDirectory) <> "" Pfad = Pfad & Left(ActiveDocument.FileName, InStrRev(ActiveDocument.FileName, ".") - 1) SeiteNr = ActiveDocument.Pages.Count While SeiteNr > 1 FormatStr = FormatStr & "0" SeiteNr = SeiteNr / 10 Wend With opt .AntiAliasingType = cdrSupersampling .ImageType = cdrRGBColorImage .Dithered = False .Overwrite = True '.Transparent = True .ResolutionX = 96 .ResolutionY = 96 '.SizeX = opt.ResolutionX * s.SizeWidth ' opt.SizeY = opt.ResolutionY * s.SizeHeight End With Set Seite = ActivePage For SeiteNr = 1 To ActiveDocument.Pages.Count ActiveDocument.Pages(SeiteNr).Activate DateiName = Pfad & Format(SeiteNr, FormatStr) & ".tif" If Dir$(DateiName) <> "" Then Kill DateiName ActiveDocument.Export DateiName, cdrTIFF, cdrCurrentPage, opt Next SeiteNr Seite.Activate AbbruchBeiFehler: CorelScript.ResumePainting End Sub |
Argumente der Funktion/Prozedur |
Hinweis |
Die Benennung der Ausgabedateien erfolgt nach dem Namen der CorelDraw-Datei und einer fortlaufenden Nummer (mit führenden Nullen, so dass die richtige Reihenfolge gewährleistet bleibt). Falls im Ausgabeverzeichnis bereits gleichnamige Dateien vorhanden sind, werden diese ohne Rückfrage überschrieben. |