'*************************************************************************
' Voraussetzung:
'*** -PS CS(2) oder PS 7 mit installiertem Scriptunterstützungsplugin
'*** -Windows als Plattform, da ein Mac leider mit VBS nicht klar kommt
' Beschreibung:
'*** -Zuerst die Pfade und Werte im "Eingabebereich" anpassen.
'*** -Die Ränder beziehen sich immer auf die gewählte Referenzseite (wird
'*** per Inputbox abgefragt).
'*** -Anschliessend die Datei speichern und die Endung von 'txt' in 'vbs'
'*** umbenennen.
'*** -Ihr könnt nun einfach Dateien per Drag'nDrop auf das Script ziehen.
'*** Wird das Script per Doppelklick gestartet, muss der Pfad der zu
'*** bearbeitenden Bilder angegeben werden. Photoshop wird, falls noch
'*** nicht geschehen, automatisch gestartet.
'*************************************************************************
Option Explicit
Dim appref, objShell, docref, strtRulerUnits, SaveOptions
Dim datei, logo,i, rand_x, rand_y, Logopfad,qualitaet,quellpfad
Dim fso, c, speichern_als,speicherpfad,datei2,zaehler,position, x1, x2, y1, y2
'*********************************************************************
'*********Anfang Eingabebereich***************************************
Logopfad="C:\temp\logo.png" 'Pfad zur Logodatei
rand_x=50 'Logoabstand vom vertikalen Bezugsrandand in Pixel
rand_y=50 'Logoabstand vom horizontalen Bezugsrandand in Pixel
speichern_als="jpg" 'in die Anführungszeichen entweder jpg oder psd eintragen
qualitaet=8 'Speicherqualitaet für jpg angeben (1..12)
quellpfad="C:\quellbilder" 'Wenn keine Bilder per Drag'nDrop auf das Script gezogen werden, werden alle Bilder aus diesem Ordner genutzt
'Achtung! Hier den Speicherpfad angeben. Ohne Angabe werden die Bilder im Quellordner gespeichert und überschrieben
speicherpfad="" 'Beispiel: speicherpfad="C:\temp" oder speicherpfad=""
'*********Ende Eingabebereich*****************************************
'*********************************************************************
Set objShell = WScript.CreateObject("WScript.Shell")
Set appref = CreateObject("Photoshop.Application")
Set logo = appref.Open (Logopfad)
if speichern_als="jpg" Then
Set SaveOptions= CreateObject("Photoshop.JPEGSaveOptions")
SaveOptions.Quality =qualitaet
Else
Set SaveOptions= CreateObject("Photoshop.PhotoshopSaveOptions")
End If
Do
position=InputBox ("Position eingeben:" & chr(13) & " ur - für unten rechts" & Chr(13) & " um - für unten mitte" _
& Chr(13) & " ul - für unten links" & Chr(13) & " or - für oben rechts" _
& Chr(13) & " om - für oben mitte" & Chr(13) & " ol - für oben links" _
, "Referenzseite","ur")
Loop While pruefung(position)=False
strtRulerUnits = appRef.Preferences.RulerUnits
appref.Preferences.RulerUnits = 1
logo.Selection.selectall
logo.Selection.copy
zaehler=0
If WScript.Arguments.count<>0 Then
For i=0 To WScript.Arguments.count-1
datei= wscript.arguments.item(i)
Set docref=appref.open (datei)
datei2=datei
logoeinfuegen
zaehler=zaehler+1
Next
Else
Set fso = CreateObject("Scripting.FileSystemObject")
Set datei=fso.getfolder (quellpfad)
For Each c In datei.Files
Set docref=appref.Open (c.Path)
datei2=c.path
logoeinfuegen
zaehler=zaehler+1
Next
End If
sub logoeinfuegen()
Select Case position
Case "ur"
x1=docref.Width -rand_x-logo.Width
y1=docref.Height - logo.Height -rand_y
x2=x1+logo.Width
y2=y1+logo.Height
Case "um"
x1=docref.Width/2 -logo.Width /2
y1=docref.Height - logo.Height -rand_y
x2=x1+logo.Width
y2=y1+logo.Height
Case "ul"
x1=rand_x
y1=docref.Height - logo.Height -rand_y
x2=x1+logo.Width
y2=y1+logo.Height
Case "or"
x1=docref.Width -rand_x-logo.Width
y1=rand_y
x2=x1+logo.Width
y2=y1+logo.Height
Case "om"
x1=(docref.Width -logo.Width )/2
y1=rand_y
x2=x1+logo.Width
y2=y1+logo.Height
Case "ol"
x1=rand_x
y1=rand_y
x2=x1+logo.Width
y1=y1+logo.Height
End Select
docref.Selection.Select Array(Array(x1 , y1), Array(x2, y1), Array(x2, y2), Array(x1 , y2)), 1, 0, False
docref.Paste True
if speichern_als="jpg" Then docref.MergeVisibleLayers
If speicherpfad<>"" Then datei=speicherpfad Else datei=datei2
docref.Saveas datei,SaveOptions, False
docref.close
End Sub
logo.Close
appref.Preferences.RulerUnits = strtRulerUnits
Select Case zaehler
Case 0
MsgBox "Es wurden keine Bilder gefunden. Falscher Pfad angegeben?"
Case 1
MsgBox "Das Logo wurde in 1 Bild eingefügt."
Case 2
MsgBox "Das Logo wurde in " & zaehler & " Bilder eingefügt."
End Select
Function pruefung(position)
Select Case position
Case "ur"
pruefung=True
Case "um"
pruefung=True
Case "ul"
pruefung=True
Case "or"
pruefung=True
Case "om"
pruefung=True
Case "ol"
pruefung=True
Case 0
WScript.quit
Case Else
MsgBox "Ungültige Eingabe"
pruefung=False
End Select
End function
