meta data for this page
Bildnummerierung
Wenn man mehrere Bilder gleich benennen und mit einer fortlaufenden Nummer versehen will, eignet sich dazu hervorragend die Stapelverarbeitung von FixFoto.
Soll dies innerhalb einer Bearbeitung mehrerer Bilder per Skript erfolgen, wird hier beispielhaft gezeigt, wie diese Aufgabe per Skript gelöst werden kann.
Es wird ein Bildername "NameNeu" festgelegt und der Ordner "Zielordner" abgefragt, in dem die nummerierten Bilder gespeichert werden sollen. Da in diesem Ordner bereits nummerierte Bilder mit dem neuen Namen abgelegt sein können, wird ermittelt, welche höchste Nummer dort existiert. Diese höchste Nummer, sie kann auch 0 sein, wird bei der danach folgende Benennung und Nummerierung berücksichtigt.
Option Explicit const NameNeu = "Muster" 'neuen Bildnamen festlegen Dim Abbruch : Abbruch = false Dim fso : Set fso = CreateObject("Scripting.FileSystemObject") Dim Bilder,Zielordner,k call main if not Abbruch then k = Bild_Max(Zielordner,NameNeu & "_") 'Korrekturwert für die Bildnummer call B_Nummerierung 'Bildnummerierung end if Set fso = Nothing '------------------------------------------------------------------------------------------------------- sub main Bilder = FF_GetSelection(1) '0 = alle Dateien der Computeransicht '1 = alle selektierten Dateien der Computeransicht '2 = alle Dateien der aktuellen Bilderliste '3 = alle selektierten Dateien der aktuellen Bilderliste if len(Bilder) = 0 then msgbox "Es wurden keine Bilder ausgewählt!",vbInformation,"Abbruch" Abbruch = true exit sub end if do 'Zielordner abfragen FF_SetCurrentPath FF_GetImagePath Zielordner = FF_EnterPath(false,"Ordner auswählen!") if Zielordner <> "" then exit do loop end sub '------------------------------------------------------------------------------------------------------- Function Bild_Max(OrdnerAngabe,FilterAngabe) 'maximale Bildnummer ermitteln Dim f,f1,fc,MBild,pos Set f = fso.GetFolder(OrdnerAngabe) Set fc = f.Files For Each f1 in fc if instr(f1.Name,FilterAngabe) = 1 then if f1.Name > MBild then MBild = f1.Name end if Next if MBild = "" then Bild_Max = 0 else pos = InStrRev(MBild,"_") if pos > 0 then Bild_Max = mid(MBild,pos+1,4) else Bild_Max = 0 if IsNumeric(Bild_Max) then Bild_Max = Bild_Max *1 else k = 0 end if Set f = nothing Set fc = nothing End Function '------------------------------------------------------------------------------------------------------- sub B_Nummerierung 'ausgewählte Bilder nummerieren Dim Array,b,extension,suffix Array = split(Bilder, vbNewLine) for b = 0 to ubound(Array) 'Bilder mit neuem Namen und fortlaufender FF_LoadImage(Array(b)) ' Nummerierung abspeichern extension = "." & fso.GetExtensionName(Array(b)) suffix = b +1 +k do while len(suffix) < 4 : suffix = "0" & suffix : loop 'len(suffix) < 4, wenn Nummerierung 4-stellig FF_SaveImage Zielordner & "\" & NameNeu & "_" & suffix & extension,0 next end sub '-------------------------------------------------------------------------------------------------------