Problem mit Script Recorder/Stapelverarbeitung :/

[schmutzbrust]

Hallo,

ich habe hier einige hundert Fotos die ich jeweils gern auf einen bestimmten Hintergrund einfügen möchte. Habe es daher mit dem Scriptrecorder und der Stapelverarbeitung versucht, aber leider funktioniert das Ganze nicht wie gewünscht.

Beispiel:

Bilder 1,2,3,4,5 .....
Hintergrund "H"

Problem:

Corel erstellt mir zwar neue Bilddateien mit meinem Wunschhintergrund. Allerdings ist auf jeder erstellten Bilddatei Bild "1" zu sehen. :/ Die fortlaufende Namensgebung der erstellten Bilddateien ist korrekt, es ist halt leider immer nur Bild "1" zu sehen. :/


sprich: (erzeugte Dateien)

Name: Bild "1" mit Hintergrund "H" --> daruf zu sehen: Bild "1"mit Hintergrund "H"
Name: Bild "2" mit Hintergrund "H" --> daruf zu sehen: Bild "1"mit Hintergrund "H"
Name: Bild "3" mit Hintergrund "H" --> daruf zu sehen: Bild "1"mit Hintergrund "H"
Name: Bild "4" mit Hintergrund "H" --> daruf zu sehen: Bild "1"mit Hintergrund "H"
Name: Bild "5" mit Hintergrund "H" --> daruf zu sehen: Bild "1"mit Hintergrund "H"



Ich hoffe es ist halbwegs verständlich, was nicht klappt. Wie kann ich dieses Problem lösen?

viele Grüße

[koter]

Hallo Schmutzbrust,

willkommen im Forum!

Du kannst es mit einem Makro probieren:

Code:

Sub BildHintergrund()
    Dim Pfad As String, Datei As String, Name1 As String, BildName As String
    Dim HGDok As Document, Bild As Document
    Dim Z As Integer
    Dim ImpFilt As ImportFilter
    Dim ExpFilt As ExportFilter
    Dim IsJpg As Boolean
    Z = 1
    BildName = "HGBild"
    Set HGDok = ActiveDocument
    Pfad = HGDok.FilePath
    Datei = HGDok.FileName
    Name1 = Dir(Pfad, vbDirectory)
    Do While Name1 <> ""
        IsJpg = Right(Name1, 4) = ".jpg"
        If Name1 <> "." And Name1 <> ".." And Name1 <> Datei And IsJpg Then
            Set ImpFilt = HGDok.Import(Pfad & Name1)
            ImpFilt.Finish
            Set ExpFilt = HGDok.Export(Pfad & BildName & Z & ".jpg", cdrJPEG)
            ExpFilt.Finish
            HGDok.Layers(1).Delete
            Z = Z + 1
        End If
        Name1 = Dir
    Loop
End Sub

Die Datei mit dem Hintergrund und die einzufügenden Bilder müssen im selben Ordner liegen.
Du musst das Hintergrundbild öffnen und dann das Makro starten.
Das Makro funktioniert nur mit JPG, kann aber für andere Dateiformate angepasst werden.

Gruß

Koter

[schmutzbrust]

Hallo Koter,

vielen Dank für deine Nachricht und sorry für die späte Rückmeldung. Ich bin beruflich grade sehr eingespannt. :/

Das Tutorial hat soweit echt gut funktioniert. Ein paar Sachen wären da aber noch:

1. Obwohl ich die die Bilder und den Hintergrund vorher exakt auf die gleiche Pixelhöhe resized habe (192) ist bei den erstellen Bildern oben ein Rand zusehen (so als ob das Bild von der Höhe etwas zu klein für den Hintergrund war)


Das zieht sich so durch alle Bilder. :/

2. Gibt es die Möglichkeit das Marko so zu erweitern, das die fertigen Bilder vielleicht in einen anderen Ordner gespeichert werden und sie den Namen des jeweiligen Ausgangbildes tragen?


viele Grüße

[schmutzbrust]

Ok, den Rand hab ich wegbekommen, indem ich einfach alle Bilder auf 193 Pixel gebracht habe...

Das mit dem Namen wäre also nur noch das Problem.

[koter]

Hallo Schmutzbrust,

Code:

Sub BildHintergrund()
   Dim ZPfad As String, Pfad As String, Datei As String, Name1 As String, BildName As String
   Dim HGDok As Document, Bild As Document
   Dim Z As Integer
   Dim ImpFilt As ImportFilter
   Dim ExpFilt As ExportFilter
   Dim IsJpg As Boolean
   Dim Antw
   Z = 0
   BildName = "HGBild"
   Set HGDok = ActiveDocument
   Pfad = HGDok.FilePath
   ZPfad = Pfad & "Zielordner"
   ZPfad = ZPfad & "\"
   Name1 = Dir(ZPfad, vbDirectory)
   If Name1 = "" Then MkDir ZPfad
   Datei = HGDok.FileName
   Name1 = Dir(Pfad, vbDirectory)
   Do While Name1 <> ""
       IsJpg = Right(Name1, 4) = ".jpg"
       If Name1 <> "." And Name1 <> ".." And Name1 <> Datei And IsJpg Then
           Set ImpFilt = HGDok.Import(Pfad & Name1)
           ImpFilt.Finish
           Set ExpFilt = HGDok.Export(ZPfad & Name1, cdrJPEG)
           ExpFilt.Finish
           HGDok.Layers(1).Delete
           Z = Z + 1
       End If
       Name1 = Dir
   Loop
   Antw = MsgBox(Z & " Dateien erstellt." & vbCrLf & "Zielordner öffnen?", vbYesNo)
   If Antw = vbYes Then Shell "explorer.exe /e, " & ZPfad, vbNormalFocus
End Sub

Wenn Du die Meldung am Schluss nicht möchtest, lösche die beiden Zeilen vor „End Sub“

Gruß

Koter

[schmutzbrust]

Hallo Koter,

danke für deine Nachricht. Jetzt hats geklappt! Vielen Dank

Hatte erst vergessen alles wieder in jpgs zu wandeln, danach lief das Makro perfekt durch.

vielen Dank nochmal für deine Hilfe