Bilder automatisch generieren mit fortlaufenden Zahlen

Super ! Es geht 1A :)

Danke !

PS: Wo finde ich mehr Infos darüber ? Kann man auch Strukturierungen einstellen ? Also, dass der Zahl z.B. immer eine "0" vorrangestellt wird...
 
Noch etwas...

Ich habe noch etwas ähnliches wie die Zahlensache zu erledigen...
Kann man sowas auch mithilfe von einem Array (wie bei PHP) einsetzen, womit ich Werte aus einer Liste auch automatisiert erstelle ? Ich muss ca. 150 Buttons machen, mit verschiedenen Texten.

Geht sowas ?

Danke
 
Sebigf hat gesagt.:
Super ! Es geht 1A :)

Danke !

PS: Wo finde ich mehr Infos darüber ? Kann man auch Strukturierungen einstellen ? Also, dass der Zahl z.B. immer eine "0" vorrangestellt wird...
Zum Vergrößern anklicken....
Du meinst bei einstelligen Zahlen? Den 'Format'-Befehl gibts unter VBS leider nicht, nur unter VB. Aber man kann sich mit einer kleinen Abfrage helfen. Ersetze die Schleife im Script durch diese:
Code: 
For i=1 To anzahl
	If i<10 Then i=0&i
    docref.ArtLayers(1).TextItem.Contents = CStr(i)
    docref.SaveAs Speicherpfad & "\" & i & ".jpg",SaveOptions, True
Next

Zum anderen Problem:
Du willst bestimmte Sachen aus einer Textdatei auslesen? Auch kein Problem. Habe mal sowas für Tischkarten gemacht. Ein Beispiel kannst du hier runterladen.
 
Geniales Script ! danke:)

Wie kann ich es machen, dass es einfach nur in die Grafik gelegt wird und als 72DPI GIF abgespeichert wird ?

## Nachtrag

Es handelt sich dabei um Foren-Buttons... leider :D
 
Zuletzt bearbeitet:
Ich möchte es so einfach haben, wie mit den Zahlen :rolleyes:

Einfach nur die Textdatei Zeile für Zeile einlesen und generieren, aber als 72DPI GIF Grafik...

Du hast ja sogar noch CMYK und das mit dieser Zusammenfassung drin.
Mit php komme ich damit klar, aber nicht VBS.... leider :)
 
Zuletzt bearbeitet:
Also immer denselben Button, nur der Text ändert sich?
Versuchs mal mit folgendem Script. Kann es aber z.Z. nicht testen:
Code: 
Dim appref, docref, dateipfad, speicherpfad, zaehler, fso, datei, Saveoptions, Namen(), protokoll

dateipfad="namen.txt" 		'Dateipfad zur Textdatei mit den Namen
Speicherpfad="c:\temp"		'Speicherpfad für erstellte Dateien

Set appref = CreateObject("Photoshop.Application")

If appref.Documents.Count=0 Then 
	MsgBox "Erst eine Datei öffnen! Danach Script erneut ausführen."
	WScript.Quit
End If
Set docref = appRef.ActiveDocument
Set Saveoptions = Createobject("Photoshop.GIFSaveOptions")

Set protokoll=docref.ActiveHistoryState 
docref.MergeVisibleLayers 
docref.SaveAs speicherpfad & "\test", Saveoptions, True
docref.ActiveHistoryState =protokoll

NamenEinlesen
For i=1 To UBound(Namen)
	docref.ArtLayers(1).TextItem.Contents = Namen(i)
	Set protokoll=docref.ActiveHistoryState 
	docref.MergeVisibleLayers 
	docref.SaveAs speicherpfad & Namen(i), Saveoptions, True
	docref.ActiveHistoryState =protokoll	
Next

Sub NamenEinlesen()
	zaehler=0
	Set fso = CreateObject("Scripting.FileSystemObject")
	Set datei = fso.opentextfile(dateipfad,1)
	
	Do While Not datei.AtEndOfStream
		Redim Preserve Namen(zaehler)
		Namen(zaehler)=datei.readline
		zaehler=zaehler+1
	Loop
	zaehler=zaehler-1
	datei.close 
End Sub

PS: Die Textebene muß in diesem Fall die oberste Ebene sein.
 
Es scheint etwas zu machen, allerdings werden keine Dateien erzeugt... zumindest nicht im Zielordner. Angaben sind richtig gemacht worden von mir...

Hast du eine Idee?
 
Ich vermute mal, du hast in deinem Stammverzeichnis jetzt einige Dateien mehr :rolleyes: ...sorry.

Ersetze diese Zeile
Code: 
	docref.SaveAs speicherpfad & Namen(i), Saveoptions, True
durch diese:
Code: 
	docref.SaveAs speicherpfad & "\" & Namen(i), Saveoptions, True
 
docref.ArtLayers(1).TextItem.Font = "Arial"
docref.ArtLayers(1).TextItem.Size= 12

geht mir ein :)

Wie stelle ich dann noch die Farbe ein


Danke :)
 
Um antworten zu können musst du eingeloggt sein.

Neue Beiträge

Zurück